Lines Matching +defs:ange +defs:ftp +defs:reread +defs:dir
0 ;;; ange-ftp.el --- transparent FTP support for GNU Emacs
6 ;; Author: Andy Norman (ange@hplb.hpl.hp.com)
42 ;; /ange@anorman:/tmp/notes
44 ;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as
45 ;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
46 ;; contents of that file as if it were on the local filesystem. If ange-ftp
53 ;; extent by changing ange-ftp-name-format. There are limitations.
57 ;; If the user part is omitted then ange-ftp generates a default user
58 ;; instead whose value depends on the variable ange-ftp-default-user.
62 ;; A password is required for each host/user pair. Ange-ftp reads passwords
63 ;; as needed. You can also specify a password with ange-ftp-set-passwd, or
68 ;; Passwords for the user "anonymous" (or "ftp") are handled
69 ;; specially. The variable `ange-ftp-generate-anonymous-password'
80 ;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to
85 ;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
91 ;; To do filename completion, ange-ftp needs a listing from the remote host.
96 ;; When ange-ftp starts up an FTP process, it leaves it running for speed
98 ;; time, but ange-ftp should be able to quietly reconnect the next time that
101 ;; Killing the "*ftp user@host*" buffer also kills the ftp process.
102 ;; This should not cause ange-ftp any grief.
106 ;; By default ange-ftp transfers files in ASCII mode. If a file being
107 ;; transferred matches the value of ange-ftp-binary-file-name-regexp then
113 ;; ACCOUNT command. ange-ftp partially supports this by allowing the user to
114 ;; specify an account password by either calling ange-ftp-set-account, or by
116 ;; is set by either of these methods then ange-ftp will issue an ACCOUNT
121 ;; ange-ftp can be preloaded, but must be put in the site-init.el file and
127 ;; Most ange-ftp commands that talk to the FTP process output a status
128 ;; message on what they are doing. In addition, ange-ftp can take advantage
131 ;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and
132 ;; ange-ftp-process-verbose for more details.
140 ;; ange-ftp has support for running the ftp process on a different (gateway)
143 ;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine
146 ;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression
147 ;; that matches hosts that can be contacted from running a local ftp
159 ;; This directory is necessary for temporary files created by ange-ftp.
161 ;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
164 ;; "/nfs/hplose/ange/ange-ftp"
166 ;; where /nfs/hplose/ange is a directory that is shared between the
169 ;; The simplest way of getting a ftp process running on the gateway machine
174 ;; 5) Set the variable ange-ftp-gateway-program to the name of the remote
177 ;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it
178 ;; isn't already. This tells ange-ftp that you are using a remote shell
181 ;; That should be all you need to allow ange-ftp to spawn a ftp process on
185 ;; 7) Set the variable ange-ftp-gateway-program to the name of the program
189 ;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular
198 ;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let
199 ;; ange-ftp know that it has to "hand-hold" the login to the gateway
202 ;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command
219 ;; If you have a "smart" ftp program that allows you to issue commands like
221 ;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
223 ;; Otherwise, if there is an alternate ftp program that implements proxy in
226 ;; Set ange-ftp-gateway-ftp-program-name to that program's name.
227 ;; Set ange-ftp-local-host-regexp to a value as stated earlier on.
228 ;; Leave ange-ftp-gateway-host set to nil.
229 ;; Set ange-ftp-smart-gateway to t.
231 ;; Tips for using ange-ftp:
243 ;; frequently, and ange-ftp seems to be unable to guess its host-type,
245 ;; (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or
246 ;; ange-ftp-cms-host-regexp) accordingly should help. Also, please report
247 ;; ange-ftp's inability to recognize the host-type as a bug.
251 ;; in it. The solution is to increase the value of ange-ftp-retry-time.
255 ;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by
259 ;; test files. See "Bugs" below. Also, note that ange-ftp copies files by
263 ;; 5. Beware that dired over ftp will use your setting of dired-no-confirm
269 ;; might be a good idea to have an alist ange-ftp-dired-no-confirm of
281 ;; Ange-ftp has full support for VMS hosts. It
283 ;; fails to do this, you can use the command ange-ftp-add-vms-host. As well,
284 ;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
315 ;; new file first. This has nothing to do with ange-ftp, but is simply
334 ;; Ange-ftp has full support for hosts running
337 ;; the command ange-ftp-add-mts-host. As well, you can set the variable
338 ;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
360 ;; Ange-ftp has full support for hosts running
363 ;; ange-ftp-add-cms-host. As well, you can set the variable
364 ;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
382 ;; need an account password. To have ange-ftp send an account password,
384 ;; ange-ftp-set-account.
385 ;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we
390 ;; Ange-ftp has full support for BS2000 hosts. It should be able to
392 ;; do this, you can use the command ange-ftp-add-bs2000-host. As well,
393 ;; you can set the variable ange-ftp-bs2000-host-regexp in your .emacs
398 ;; command ange-ftp-add-bs2000-posix-host for that particular
399 ;; hostname. ange-ftp can't decide if you want to access the native
403 ;; ange-ftp-binary-file-name-regexp to access its files.
422 ;; (setq ange-ftp-bs2000-additional-pubsets '(":X:"))
428 ;; ange-ftp-bs2000-special-prefix because names starting with # or @
444 ;; always need an account password. To have ange-ftp send an account
446 ;; ange-ftp-set-account.
453 ;; Be warned that files created by using ange-ftp will take account of the
454 ;; umask of the ftp daemon process rather than the umask of the creating
456 ;; The way that I tighten up the ftp daemon's umask under HP-UX is to make
463 ;; ange-ftp-kill-ftp-process can restart the ftp process, which
466 ;; 3. Ange-ftp does not check to make sure that when creating a new file,
469 ;; translate your filename in some way. This may cause ange-ftp to
475 ;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons.
477 ;; 5. Ange-ftp likes to use pty's to talk to its FTP processes. If GNU Emacs
479 ;; ange-ftp won't be getting the information it requires at the time that
488 ;; 7. Some CMS machines do not assign a default minidisk when you ftp them as
490 ;; to it. This is (understandably) beyond ange-ftp.
493 ;; Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp
497 ;; particularly problematical. Should ange-ftp-binary-file-name-regexp be
500 ;; 9. The code to do compression of files over ftp is not as careful as it
507 ;; truncated. Then, ange-ftp would delete the only remaining version of
508 ;; the file. Maybe ange-ftp should make backups when it compresses files
512 ;; 10. If a dir listing is attempted for an empty directory on (at least
513 ;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
514 ;; I don't know how to get ange-ftp work to around it.
526 ;; ange-ftp looks to chop trailing @'s off of symlink names when it is
527 ;; parsing a listing with the F switch. This will cause ange-ftp to
529 ;; ends in an @. ange-ftp will correct itself if you take F out of the
531 ;; dired buffer will be automatically reverted, which will allow ange-ftp
533 ;; fast, sure-fire way to recognize ULTRIX over ftp.
536 ;; the above author, or send a message to the ange-ftp-lovers mailing list
539 ;; ange-ftp-lovers:
541 ;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All
542 ;; users of ange-ftp are welcome to subscribe (see below) and to discuss
543 ;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to
546 ;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the
549 ;; ange-ftp-lovers-request@hplb.hpl.hp.com
553 ;; For mail to be posted directly to ange-ftp-lovers, send to one of the
556 ;; ange-ftp-lovers@hplb.hpl.hp.com
559 ;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be
568 ;; ange-ftp works by putting a handler on file-name-handler-alist
577 ;; ange-ftp-fix-name-for-TYPE
578 ;; ange-ftp-fix-dir-name-for-TYPE
579 ;; ange-ftp-TYPE-host
580 ;; ange-ftp-TYPE-add-host
581 ;; ange-ftp-parse-TYPE-listing
582 ;; ange-ftp-TYPE-delete-file-entry
583 ;; ange-ftp-TYPE-add-file-entry
584 ;; ange-ftp-TYPE-file-name-as-directory
585 ;; ange-ftp-TYPE-make-compressed-filename
586 ;; ange-ftp-TYPE-file-name-sans-versions
590 ;; ange-ftp-TYPE-host-regexp
591 ;; May need to add TYPE to ange-ftp-dumb-host-types
595 ;; ange-ftp-host-type
596 ;; ange-ftp-guess-host-type
597 ;; ange-ftp-allow-child-lookup
601 ;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type
608 ;; ange-ftp-dired-host-type for local buffers.
616 ;; TYPE:LIST = a remote host of TYPE type, using a specialized ftp listing
618 ;; dl (descriptive listings), when ange-ftp-dired-host-type
630 ;; 1: See ange-ftp-ls
656 ;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
660 ;; Thanks to Dave Smith who wrote the info file for ange-ftp.
666 ;; Mathur, the folks on the ange-ftp-lovers mailing list and many others
668 ;; ange-ftp.el.
685 (defgroup ange-ftp nil
689 :prefix "ange-ftp-")
691 (defcustom ange-ftp-name-format
699 :group 'ange-ftp
705 ;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
706 ;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
707 ;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
709 (defvar ange-ftp-multi-msgs
711 "*Regular expression matching the start of a multiline ftp reply.")
713 (defvar ange-ftp-good-msgs
715 "*Regular expression matching ftp \"success\" messages.")
719 ;; don't have write permission. ange-ftp gets into multi-line skip
728 (defcustom ange-ftp-skip-msgs
736 "*Regular expression matching ftp messages that can be ignored."
737 :group 'ange-ftp
740 (defcustom ange-ftp-fatal-msgs
741 (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
743 "*Regular expression matching ftp messages that indicate serious errors.
746 :group 'ange-ftp
749 (defcustom ange-ftp-potential-error-msgs
752 ;; ftp> open ftp.nluug.nl
754 ;; ftp: connect to address 2001:610:1:80aa:192:87:102:36: No route to host
756 ;; Connected to ftp.nluug.nl.
757 "^ftp: connect to address .*: No route to host"
758 "*Regular expression matching ftp messages that can indicate serious errors.
761 :group 'ange-ftp
764 (defcustom ange-ftp-gateway-fatal-msgs
767 :group 'ange-ftp
770 (defcustom ange-ftp-xfer-size-msgs
773 :group 'ange-ftp
776 (defcustom ange-ftp-tmp-name-template
777 (expand-file-name "ange-ftp" temporary-file-directory)
779 :group 'ange-ftp
782 (defcustom ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
783 "*Template used to create temporary files when ftp-ing through a gateway.
789 :group 'ange-ftp
792 (defcustom ange-ftp-netrc-filename "~/.netrc"
794 :group 'ange-ftp
797 (defcustom ange-ftp-disable-netrc-security-check (eq system-type 'windows-nt)
799 :group 'ange-ftp
802 (defcustom ange-ftp-default-user nil
806 If nil, the value of `ange-ftp-netrc-default-user' is used.
811 ange-ftp. Use \\[ange-ftp-set-user] to change the cached values,
812 since setting `ange-ftp-default-user' directly does not affect
814 :group 'ange-ftp
819 (defcustom ange-ftp-netrc-default-user nil
824 :group 'ange-ftp
828 (defcustom ange-ftp-default-password nil
829 "*Password to use when the user name equals `ange-ftp-default-user'."
830 :group 'ange-ftp
834 (defcustom ange-ftp-default-account nil
835 "*Account to use when the user name equals `ange-ftp-default-user'."
836 :group 'ange-ftp
840 (defcustom ange-ftp-netrc-default-password nil
841 "*Password to use when the user name equals `ange-ftp-netrc-default-user'."
842 :group 'ange-ftp
846 (defcustom ange-ftp-netrc-default-account nil
847 "*Account to use when the user name equals `ange-ftp-netrc-default-user'."
848 :group 'ange-ftp
852 (defcustom ange-ftp-generate-anonymous-password t
853 "*If t, use value of `user-mail-address' as password for anonymous ftp.
857 :group 'ange-ftp
862 (defcustom ange-ftp-dumb-unix-host-regexp nil
863 "*If non-nil, regexp matching hosts on which `dir' command lists directory."
864 :group 'ange-ftp
868 (defcustom ange-ftp-binary-file-name-regexp
875 :group 'ange-ftp
878 (defcustom ange-ftp-gateway-host nil
880 :group 'ange-ftp
884 (defcustom ange-ftp-local-host-regexp ".*"
885 "*Regexp selecting hosts which can be reached directly with ftp.
887 For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
888 instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'."
889 :group 'ange-ftp
892 (defcustom ange-ftp-gateway-program-interactive nil
896 :group 'ange-ftp
899 (defcustom ange-ftp-gateway-program remote-shell-program
904 :group 'ange-ftp
910 (defcustom ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
917 :group 'ange-ftp
920 (defvar ange-ftp-gateway-setup-term-command
928 (defcustom ange-ftp-smart-gateway nil
929 "*Non-nil says the ftp gateway (proxy) or gateway ftp program is smart.
932 or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.
933 See also `ange-ftp-smart-gateway-port'."
934 :group 'ange-ftp
937 (defcustom ange-ftp-smart-gateway-port "21"
939 :group 'ange-ftp
942 (defcustom ange-ftp-send-hash t
944 :group 'ange-ftp
947 (defcustom ange-ftp-binary-hash-mark-size nil
952 :group 'ange-ftp
956 (defcustom ange-ftp-ascii-hash-mark-size 1024
960 :group 'ange-ftp
963 (defcustom ange-ftp-process-verbose t
965 :group 'ange-ftp
968 (defcustom ange-ftp-ftp-program-name "ftp"
970 :group 'ange-ftp
973 (defcustom ange-ftp-gateway-ftp-program-name "ftp"
977 :group 'ange-ftp
980 (defcustom ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
982 :group 'ange-ftp
985 (defcustom ange-ftp-nslookup-program nil
987 :group 'ange-ftp
991 (defcustom ange-ftp-make-backup-files ()
993 :group 'ange-ftp
996 (defcustom ange-ftp-retry-time 5
999 :group 'ange-ftp
1002 (defcustom ange-ftp-auto-save 0
1003 "If 1, allow ange-ftp files to be auto-saved.
1004 If 0, inhibit auto-saving of ange-ftp files.
1006 :group 'ange-ftp
1010 (defcustom ange-ftp-try-passive-mode nil
1011 "If t, try to use passive mode in ftp, if the client program supports it."
1012 :group 'ange-ftp
1016 (defcustom ange-ftp-passive-host-alist nil
1022 :group 'ange-ftp
1035 (defun ange-ftp-hash-entry-exists-p (key tbl)
1039 (defun ange-ftp-hash-table-keys (tbl)
1051 (defvar ange-ftp-data-buffer-name " *ftp data*"
1052 "Buffer name to hold directory listing data received from ftp process.")
1054 (defvar ange-ftp-netrc-modtime nil
1057 (defvar ange-ftp-user-hashtable (make-hash-table :test 'equal)
1060 (defvar ange-ftp-passwd-hashtable (make-hash-table :test 'equal)
1064 (defvar ange-ftp-account-hashtable (make-hash-table :test 'equal)
1067 (defvar ange-ftp-files-hashtable (make-hash-table :test 'equal :size 97)
1070 (defvar ange-ftp-inodes-hashtable (make-hash-table :test 'equal :size 97)
1073 (defvar ange-ftp-next-inode-number 1
1076 (defvar ange-ftp-ls-cache-lsargs nil
1077 "Last set of args used by ange-ftp-ls.")
1079 (defvar ange-ftp-ls-cache-file nil
1080 "Last file passed to ange-ftp-ls.")
1082 (defvar ange-ftp-ls-cache-res nil
1083 "Last result returned from ange-ftp-ls.")
1085 (defconst ange-ftp-expand-dir-hashtable (make-hash-table :test 'equal))
1087 (defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):")
1090 (defvar ange-ftp-hash-mark-unit nil)
1091 (defvar ange-ftp-hash-mark-count nil)
1092 (defvar ange-ftp-xfer-size nil)
1093 (defvar ange-ftp-process-string nil)
1094 (defvar ange-ftp-process-result-line nil)
1095 (defvar ange-ftp-pending-error-line nil)
1096 (defvar ange-ftp-process-busy nil)
1097 (defvar ange-ftp-process-result nil)
1098 (defvar ange-ftp-process-multi-skip nil)
1099 (defvar ange-ftp-process-msg nil)
1100 (defvar ange-ftp-process-continue nil)
1101 (defvar ange-ftp-last-percent nil)
1105 (defvar ange-ftp-this-file)
1106 (defvar ange-ftp-this-dir)
1107 (defvar ange-ftp-this-user)
1108 (defvar ange-ftp-this-host)
1109 (defvar ange-ftp-this-msg)
1110 (defvar ange-ftp-completion-ignored-pattern)
1111 (defvar ange-ftp-trample-marker)
1115 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
1116 ;; (put 'ftp-error 'error-message "FTP error")
1123 (defun ange-ftp-message (fmt &rest args)
1135 (defun ange-ftp-abbreviate-filename (file &optional new)
1156 (defun ange-ftp-set-user (host user)
1159 (puthash host user ange-ftp-user-hashtable))
1161 (defun ange-ftp-get-user (host)
1163 (ange-ftp-parse-netrc)
1164 (let ((user (gethash host ange-ftp-user-hashtable)))
1168 (cond ((stringp ange-ftp-default-user)
1170 ange-ftp-default-user)
1171 (ange-ftp-default-user
1176 (ange-ftp-netrc-default-user)
1180 (ange-ftp-set-user host user)))))
1187 (defmacro ange-ftp-generate-passwd-key (host user)
1190 (defmacro ange-ftp-lookup-passwd (host user)
1191 `(gethash (ange-ftp-generate-passwd-key ,host ,user)
1192 ange-ftp-passwd-hashtable))
1194 (defun ange-ftp-set-passwd (host user passwd)
1199 (puthash (ange-ftp-generate-passwd-key host user)
1200 passwd ange-ftp-passwd-hashtable))
1202 (defun ange-ftp-get-host-with-passwd (user)
1204 (ange-ftp-parse-netrc)
1208 (if (ange-ftp-lookup-passwd host user) (throw 'found-one host)))
1209 ange-ftp-user-hashtable)
1218 ange-ftp-passwd-hashtable))
1221 (defun ange-ftp-get-passwd (host user)
1223 (ange-ftp-parse-netrc)
1227 (cond ((ange-ftp-lookup-passwd host user))
1230 ((and (stringp ange-ftp-default-user)
1231 ange-ftp-default-password
1232 (string-equal user ange-ftp-default-user))
1233 ange-ftp-default-password)
1236 ((and (stringp ange-ftp-netrc-default-user)
1237 ange-ftp-netrc-default-password
1238 (string-equal user ange-ftp-netrc-default-user))
1239 ange-ftp-netrc-default-password)
1241 ;; anonymous ftp password is handled specially since there is an
1244 (string-equal user "ftp"))
1245 ange-ftp-generate-anonymous-password)
1246 (if (stringp ange-ftp-generate-anonymous-password)
1247 ange-ftp-generate-anonymous-password
1253 (let* ((other (ange-ftp-get-host-with-passwd user))
1262 (ange-ftp-lookup-passwd other user))
1267 (ange-ftp-set-passwd host user passwd)
1276 ;; manually by calling ange-ftp-set-account. For the moment, ange-ftp doesn't
1280 (defun ange-ftp-set-account (host user account)
1285 (puthash (ange-ftp-generate-passwd-key host user)
1286 account ange-ftp-account-hashtable))
1288 (defun ange-ftp-get-account (host user)
1290 (ange-ftp-parse-netrc)
1291 (or (gethash (ange-ftp-generate-passwd-key host user)
1292 ange-ftp-account-hashtable)
1293 (and (stringp ange-ftp-default-user)
1294 (string-equal user ange-ftp-default-user)
1295 ange-ftp-default-account)
1296 (and (stringp ange-ftp-netrc-default-user)
1297 (string-equal user ange-ftp-netrc-default-user)
1298 ange-ftp-netrc-default-account)))
1305 (defun ange-ftp-chase-symlinks (file)
1308 (while (setq temp (ange-ftp-real-file-symlink-p file))
1321 (defun ange-ftp-parse-netrc-token (token limit)
1339 (defun ange-ftp-parse-netrc-group ()
1356 (setq machine (ange-ftp-parse-netrc-token "machine" end)
1357 login (ange-ftp-parse-netrc-token "login" end)
1358 password (ange-ftp-parse-netrc-token "password" end)
1359 account (ange-ftp-parse-netrc-token "account" end))
1363 (ange-ftp-set-user machine login)
1364 (ange-ftp-set-passwd machine login password)
1366 (ange-ftp-set-account machine login account)))
1371 (setq login (ange-ftp-parse-netrc-token "login" end)
1372 password (ange-ftp-parse-netrc-token "password" end)
1373 account (ange-ftp-parse-netrc-token "account" end))
1375 (setq ange-ftp-netrc-default-user login))
1377 (setq ange-ftp-netrc-default-password password))
1379 (setq ange-ftp-netrc-default-account account)))))
1386 (defun ange-ftp-parse-netrc ()
1388 ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
1392 (setq file (ange-ftp-chase-symlinks
1393 (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
1394 (setq attr (ange-ftp-real-file-attributes file)))
1396 (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed
1398 (if (or ange-ftp-disable-netrc-security-check
1406 (generate-new-buffer "*ftp-.netrc*")
1407 (ange-ftp-real-insert-file-contents file)
1416 (ange-ftp-parse-netrc-group))
1418 (ange-ftp-message "%s either not owned by you or badly protected."
1419 ange-ftp-netrc-filename)
1421 (setq ange-ftp-netrc-modtime (nth 5 attr))))))
1426 (defun ange-ftp-generate-root-prefixes ()
1427 (ange-ftp-parse-netrc)
1436 ange-ftp-passwd-hashtable)
1439 ange-ftp-user-hashtable)
1447 (defmacro ange-ftp-ftp-name-component (n ns name)
1448 "Extract the Nth ftp file name component from NS."
1452 (defvar ange-ftp-ftp-name-arg "")
1453 (defvar ange-ftp-ftp-name-res nil)
1455 ;; Parse NAME according to `ange-ftp-name-format' (which see).
1457 (defun ange-ftp-ftp-name (name)
1458 (if (string-equal name ange-ftp-ftp-name-arg)
1459 ange-ftp-ftp-name-res
1460 (setq ange-ftp-ftp-name-arg name
1461 ange-ftp-ftp-name-res
1463 (if (posix-string-match (car ange-ftp-name-format) name)
1464 (let* ((ns (cdr ange-ftp-name-format))
1465 (host (ange-ftp-ftp-name-component 0 ns name))
1466 (user (ange-ftp-ftp-name-component 1 ns name))
1467 (name (ange-ftp-ftp-name-component 2 ns name)))
1469 (setq user (ange-ftp-get-user host)))
1473 ;; Take a FULLNAME that matches according to ange-ftp-name-format and
1475 (defun ange-ftp-replace-name-component (fullname name)
1477 (if (posix-string-match (car ange-ftp-name-format) fullname)
1478 (let* ((ns (cdr ange-ftp-name-format))
1489 ;; (setq ange-ftp-tmp-keymap (make-sparse-keymap))
1490 ;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
1492 (defun ange-ftp-repaint-minibuffer ()
1496 ;; Return the name of the buffer that collects output from the ftp process
1498 (defun ange-ftp-ftp-process-buffer (host user)
1499 (concat "*ftp " user "@" host "*"))
1501 ;; Display the last chunk of output from the ftp process for the given HOST
1503 (defun ange-ftp-error (host user msg)
1509 (ange-ftp-ftp-process-buffer host user)))
1512 (signal 'ftp-error (list (format "FTP Error: %s" msg)))))
1514 (defun ange-ftp-set-buffer-mode ()
1517 (ange-ftp-ftp-name buffer-file-name))
1518 (auto-save-mode ange-ftp-auto-save)))
1520 (defun ange-ftp-kill-ftp-process (&optional buffer)
1522 If the BUFFER's visited filename or default-directory is an ftp filename
1523 then kill the related ftp process."
1531 (let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
1535 (kill-buffer (get-buffer (ange-ftp-ftp-process-buffer host user)))))))))
1537 (defun ange-ftp-quote-string (string)
1538 "Quote any characters in STRING that may confuse the ftp process."
1541 ;; This is said to be wrong; ftp is said to
1544 ;; when talking to ftp on GNU/Linux systems.
1553 (defun ange-ftp-barf-if-not-directory (directory)
1567 (defun ange-ftp-process-handle-line (line proc)
1568 "Look at the given LINE from the ftp process PROC.
1571 (cond ((string-match ange-ftp-xfer-size-msgs line)
1572 (setq ange-ftp-xfer-size
1575 ((string-match ange-ftp-skip-msgs line)
1577 ((string-match ange-ftp-good-msgs line)
1578 (setq ange-ftp-process-busy nil
1579 ange-ftp-process-result t
1580 ange-ftp-pending-error-line nil
1581 ange-ftp-process-result-line line))
1586 ;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
1587 ((string-match ange-ftp-multi-msgs line)
1588 (setq ange-ftp-process-multi-skip t))
1589 ((string-match ange-ftp-potential-error-msgs line)
1593 (set (make-local-variable 'ange-ftp-pending-error-line) line)
1595 ((string-match ange-ftp-fatal-msgs line)
1597 (setq ange-ftp-process-busy nil
1598 ange-ftp-process-result-line line))
1599 (ange-ftp-process-multi-skip
1602 (setq ange-ftp-process-busy nil
1603 ange-ftp-process-result-line line))))
1605 (defun ange-ftp-set-xfer-size (host user bytes)
1607 (let ((proc (ange-ftp-get-process host user)))
1612 (setq ange-ftp-xfer-size
1618 (defun ange-ftp-process-handle-hash (str)
1622 ange-ftp-hash-mark-count (+ (- (match-end 0)
1624 ange-ftp-hash-mark-count))
1625 (and ange-ftp-hash-mark-unit
1626 ange-ftp-process-msg
1627 ange-ftp-process-verbose
1631 (let ((kbytes (ash (* ange-ftp-hash-mark-unit
1632 ange-ftp-hash-mark-count)
1634 (if (zerop ange-ftp-xfer-size)
1635 (ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes)
1636 (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size)))
1638 (unless (eq percent ange-ftp-last-percent)
1639 (setq ange-ftp-last-percent percent)
1640 (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))
1648 (defun ange-ftp-call-cont (cont result line)
1655 ;; Build up a complete line of output from the ftp PROCESS and pass it
1656 ;; on to ange-ftp-process-handle-line to deal with.
1658 (defun ange-ftp-process-filter (proc str)
1668 (and ange-ftp-process-busy
1670 (setq str (ange-ftp-process-handle-hash str)))
1675 (if ange-ftp-process-busy
1677 (setq ange-ftp-process-string (concat ange-ftp-process-string
1682 (if (string-match "Password: *$" ange-ftp-process-string)
1684 (while (and ange-ftp-process-busy
1685 (string-match "\n" ange-ftp-process-string))
1686 (let ((line (substring ange-ftp-process-string
1690 (setq ange-ftp-process-string (substring ange-ftp-process-string
1692 (while (string-match "\\`ftp> *" line)
1695 (if (not (and seen-prompt ange-ftp-pending-error-line))
1696 (ange-ftp-process-handle-line line proc)
1701 (setq ange-ftp-process-busy nil
1702 ange-ftp-process-result-line ange-ftp-pending-error-line))))
1704 ;; has the ftp client finished? if so then do some clean-up
1706 (if (not ange-ftp-process-busy)
1709 (setq ange-ftp-xfer-size 0)
1712 (if (and ange-ftp-process-msg
1713 ange-ftp-process-verbose
1714 ange-ftp-process-result)
1716 (ange-ftp-message "%s...done" ange-ftp-process-msg)
1717 (ange-ftp-repaint-minibuffer)
1718 (setq ange-ftp-process-msg nil)))
1722 (if ange-ftp-process-continue
1723 (let ((cont ange-ftp-process-continue))
1724 (setq ange-ftp-process-continue nil)
1725 (ange-ftp-call-cont cont
1726 ange-ftp-process-result
1727 ange-ftp-process-result-line))))))))
1729 (defun ange-ftp-process-sentinel (proc str)
1730 "When ftp process changes state, nuke all file-entries in cache."
1732 (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
1735 (ange-ftp-wipe-file-entries host user))))
1736 (setq ange-ftp-ls-cache-file nil))
1743 (defun ange-ftp-use-gateway-p (host)
1747 (and (not ange-ftp-smart-gateway)
1749 (not (string-match ange-ftp-local-host-regexp host)))))
1751 (defun ange-ftp-use-smart-gateway-p (host)
1753 (and ange-ftp-smart-gateway
1755 (not (string-match ange-ftp-local-host-regexp host)))))
1763 (defun ange-ftp-make-tmp-name (host)
1765 (make-temp-file (if (ange-ftp-use-gateway-p host)
1766 ange-ftp-gateway-tmp-name-template
1767 ange-ftp-tmp-name-template)))
1769 (defalias 'ange-ftp-del-tmp-name 'delete-file)
1776 (defvar ange-ftp-gwp-running t)
1777 (defvar ange-ftp-gwp-status nil)
1779 (defun ange-ftp-gwp-sentinel (proc str)
1780 (setq ange-ftp-gwp-running nil))
1782 (defun ange-ftp-gwp-filter (proc str)
1790 (let ((ange-ftp-default-user t))
1791 (ange-ftp-get-user ange-ftp-gateway-host))
1796 (ange-ftp-get-passwd ange-ftp-gateway-host
1797 (ange-ftp-get-user
1798 ange-ftp-gateway-host))
1800 ((string-match ange-ftp-gateway-fatal-msgs str)
1802 (setq ange-ftp-gwp-running nil))
1803 ((string-match ange-ftp-gateway-prompt-pattern str)
1804 (setq ange-ftp-gwp-running nil
1805 ange-ftp-gwp-status t))))
1807 (defun ange-ftp-gwp-start (host user name args)
1808 "Login to the gateway machine and fire up an ftp process."
1810 ;; but that doesn't work: ftp never responds.
1814 ange-ftp-gateway-program
1815 ange-ftp-gateway-host)))
1816 (ftp (mapconcat 'identity args " ")))
1818 (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
1819 (set-process-filter proc 'ange-ftp-gwp-filter)
1823 (setq ange-ftp-gwp-running t
1824 ange-ftp-gwp-status nil)
1825 (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)
1826 (while ange-ftp-gwp-running ;perform login sequence
1828 (if (not ange-ftp-gwp-status)
1829 (ange-ftp-error host user "unable to login to gateway"))
1830 (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host)
1831 (setq ange-ftp-gwp-running t
1832 ange-ftp-gwp-status nil)
1833 (process-send-string proc ange-ftp-gateway-setup-term-command)
1834 (while ange-ftp-gwp-running ;zap ^M's and double echoing.
1836 (if (not ange-ftp-gwp-status)
1837 (ange-ftp-error host user "unable to set terminal modes on gateway"))
1838 (setq ange-ftp-gwp-running t
1839 ange-ftp-gwp-status nil)
1840 (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
1845 ;;;; Support for sending commands to the ftp process.
1848 (defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
1849 "Low-level routine to send the given ftp CMD to the ftp PROCESS.
1852 and some arguments. The function will be called when the ftp command
1861 (ange-ftp-wait-not-busy proc)
1862 (setq ange-ftp-process-string ""
1863 ange-ftp-process-result-line ""
1864 ange-ftp-process-busy t
1865 ange-ftp-process-result nil
1866 ange-ftp-process-multi-skip nil
1867 ange-ftp-process-msg msg
1868 ange-ftp-process-continue cont
1869 ange-ftp-hash-mark-count 0
1870 ange-ftp-last-percent -1
1872 (and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg))
1885 (ange-ftp-wait-not-busy proc)
1888 (cons ange-ftp-process-result ange-ftp-process-result-line))))))
1890 ;; Wait for the ange-ftp process PROC not to be busy.
1891 (defun ange-ftp-wait-not-busy (proc)
1894 ;; This is a kludge to let user quit in case ftp gets hung.
1902 (while ange-ftp-process-busy
1907 ;; The next operation will open a new ftp connection.
1911 (defun ange-ftp-nslookup-host (host)
1914 (if ange-ftp-nslookup-program
1920 ;; but that doesn't work: ftp never responds.
1924 ange-ftp-nslookup-program host)))
1937 (defun ange-ftp-start-process (host user name)
1938 "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
1939 If HOST is only ftp-able through a gateway machine then spawn a shell
1940 on the gateway machine to do the ftp instead."
1941 (let* ((use-gateway (ange-ftp-use-gateway-p host))
1942 (use-smart-ftp (and (not ange-ftp-gateway-host)
1943 (ange-ftp-use-smart-gateway-p host)))
1944 (ftp-prog (if (or use-gateway
1945 use-smart-ftp)
1946 ange-ftp-gateway-ftp-program-name
1947 ange-ftp-ftp-program-name))
1948 (args (append (list ftp-prog) ange-ftp-ftp-program-args))
1949 ;; Without the following binding, ange-ftp-start-process
1960 ;; but that doesn't work: ftp never responds.
1967 (internal-ange-ftp-mode))
1968 ;; This tells GNU ftp not to output any fancy escape sequences.
1971 (if ange-ftp-gateway-program-interactive
1972 (setq proc (ange-ftp-gwp-start host user name args))
1974 (append (list ange-ftp-gateway-program
1975 ange-ftp-gateway-host)
1982 (set-process-sentinel proc 'ange-ftp-process-sentinel)
1983 (set-process-filter proc 'ange-ftp-process-filter)
1984 ;; On Windows, the standard ftp client buffers its output (because
1993 ;; force ftp output to be treated as DOS text, otherwise the
1997 (accept-process-output proc) ;wait for ftp startup message
2000 (put 'internal-ange-ftp-mode 'mode-class 'special)
2002 (defun internal-ange-ftp-mode ()
2008 (setq major-mode 'internal-ange-ftp-mode)
2009 (setq mode-name "Internal Ange-ftp")
2010 (make-local-variable 'ange-ftp-process-string)
2011 (setq ange-ftp-process-string "")
2012 (make-local-variable 'ange-ftp-process-busy)
2013 (make-local-variable 'ange-ftp-process-result)
2014 (make-local-variable 'ange-ftp-process-msg)
2015 (make-local-variable 'ange-ftp-process-multi-skip)
2016 (make-local-variable 'ange-ftp-process-result-line)
2017 (make-local-variable 'ange-ftp-process-continue)
2018 (make-local-variable 'ange-ftp-hash-mark-count)
2019 (make-local-variable 'ange-ftp-binary-hash-mark-size)
2020 (make-local-variable 'ange-ftp-ascii-hash-mark-size)
2021 (make-local-variable 'ange-ftp-hash-mark-unit)
2022 (make-local-variable 'ange-ftp-xfer-size)
2023 (make-local-variable 'ange-ftp-last-percent)
2024 (setq ange-ftp-hash-mark-count 0)
2025 (setq ange-ftp-xfer-size 0)
2026 (setq ange-ftp-process-result-line "")
2027 (setq comint-prompt-regexp "^ftp> ")
2030 ;; ange-ftp has its own ways of handling passwords.
2034 (run-mode-hooks 'internal-ange-ftp-mode-hook))
2036 (defcustom ange-ftp-raw-login nil
2037 "*Use raw ftp commands for login, if account password is not nil.
2038 Some ftp implementations need this, e.g. ftp in NT 4.0."
2039 :group 'ange-ftp
2043 (defun ange-ftp-smart-login (host user pass account proc)
2046 host specified in `ange-ftp-gateway-host'."
2047 (let ((result (ange-ftp-raw-send-cmd
2050 (ange-ftp-nslookup-host ange-ftp-gateway-host)
2051 ange-ftp-smart-gateway-port)
2054 ange-ftp-gateway-host))))
2056 (ange-ftp-error host user
2059 (setq result (ange-ftp-raw-send-cmd
2062 (ange-ftp-nslookup-host host)
2069 (ange-ftp-set-passwd host user nil) ; reset password
2070 (ange-ftp-set-account host user nil) ; reset account
2071 (ange-ftp-error host user
2075 (defun ange-ftp-normal-login (host user pass account proc)
2081 (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
2083 (result (ange-ftp-raw-send-cmd
2090 (ange-ftp-error host user
2093 (if (not (and ange-ftp-raw-login (string< "" account)))
2094 (setq result (ange-ftp-raw-send-cmd
2096 (if (and (ange-ftp-use-smart-gateway-p host)
2097 ange-ftp-gateway-host)
2102 (let ((good ange-ftp-good-msgs)
2103 (skip ange-ftp-skip-msgs))
2104 (setq ange-ftp-good-msgs (concat ange-ftp-good-msgs
2106 (if (string-match (regexp-quote "\\|^331 ") ange-ftp-skip-msgs)
2107 (setq ange-ftp-skip-msgs
2108 (replace-match "" t t ange-ftp-skip-msgs)))
2109 (if (string-match (regexp-quote "\\|^332 ") ange-ftp-skip-msgs)
2110 (setq ange-ftp-skip-msgs
2111 (replace-match "" t t ange-ftp-skip-msgs)))
2112 (setq result (ange-ftp-raw-send-cmd
2117 (setq result (ange-ftp-raw-send-cmd
2122 (setq result (ange-ftp-raw-send-cmd
2127 (setq ange-ftp-good-msgs good
2128 ange-ftp-skip-msgs skip)))
2131 (ange-ftp-set-passwd host user nil) ;reset password.
2132 (ange-ftp-set-account host user nil) ;reset account.
2133 (ange-ftp-error host user
2137 ;; ange@hplb.hpl.hp.com says this should not be changed.
2138 (defvar ange-ftp-hash-mark-msgs
2142 (defun ange-ftp-guess-hash-mark-size (proc)
2143 (if ange-ftp-send-hash
2145 (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
2148 (if (string-match ange-ftp-hash-mark-msgs line)
2150 (setq ange-ftp-ascii-hash-mark-size size
2151 ange-ftp-hash-mark-unit (ash size -4))
2154 (or ange-ftp-binary-hash-mark-size
2155 (setq ange-ftp-binary-hash-mark-size size)))))))))
2157 (defvar ange-ftp-process-startup-hook nil)
2159 (defun ange-ftp-get-process (host user)
2162 (let* ((name (ange-ftp-ftp-process-buffer host user))
2168 (let ((pass (ange-ftp-quote-string
2169 (ange-ftp-get-passwd host user)))
2170 (account (ange-ftp-quote-string
2171 (ange-ftp-get-account host user))))
2173 (setq proc (ange-ftp-start-process host user name))
2176 (if (and (ange-ftp-use-smart-gateway-p host)
2177 ange-ftp-gateway-host)
2178 (ange-ftp-smart-login host user pass account proc)
2179 (ange-ftp-normal-login host user pass account proc))
2183 (ange-ftp-guess-hash-mark-size proc)
2186 (ange-ftp-guess-host-type host user)
2191 (or (assoc-default host ange-ftp-passive-host-alist
2193 (if ange-ftp-try-passive-mode "on"))))
2195 (ange-ftp-passive-mode proc passive)))
2199 (let ((ange-ftp-this-user user)
2200 (ange-ftp-this-host host))
2201 (run-hooks 'ange-ftp-process-startup-hook)))
2204 (defun ange-ftp-passive-mode (proc on-or-off)
2206 (cdr (ange-ftp-raw-send-cmd
2209 (ange-ftp-message (concat "Trying passive mode..." on-or-off))
2213 (defvar ange-ftp-host-cache nil)
2214 (defvar ange-ftp-host-type-cache nil)
2216 ;; If ange-ftp-host-type is called with the optional user
2220 ;; to ange-ftp-host-type where it should have been supplied?
2222 (defun ange-ftp-host-type (host &optional user)
2229 ((eq host ange-ftp-host-cache)
2230 ange-ftp-host-type-cache)
2231 ;; Trigger an ftp connection, in case we need to guess at the host type.
2232 ((and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
2233 ange-ftp-host-type-cache)
2235 (setq ange-ftp-host-cache host
2236 ange-ftp-host-type-cache
2237 (cond ((ange-ftp-dumb-unix-host host)
2239 ;; ((and (fboundp 'ange-ftp-vos-host)
2240 ;; (ange-ftp-vos-host host))
2242 ((and (fboundp 'ange-ftp-vms-host)
2243 (ange-ftp-vms-host host))
2245 ((and (fboundp 'ange-ftp-mts-host)
2246 (ange-ftp-mts-host host))
2248 ((and (fboundp 'ange-ftp-cms-host)
2249 (ange-ftp-cms-host host))
2251 ((and (fboundp 'ange-ftp-bs2000-posix-host)
2252 (ange-ftp-bs2000-posix-host host))
2254 ((and (fboundp 'ange-ftp-bs2000-host)
2255 (ange-ftp-bs2000-host host))
2260 ;; It would be nice to abstract the functions ange-ftp-TYPE-host and
2261 ;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
2263 ;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to
2268 (defvar ange-ftp-fix-name-func-alist nil
2274 (defvar ange-ftp-fix-dir-name-func-alist nil
2282 (defvar ange-ftp-dumb-host-types '(dumb-unix)
2285 (defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
2286 "Find an ftp process connected to HOST logged in as USER and send it CMD.
2289 See the documentation for `ange-ftp-raw-send-cmd' for a description of CONT
2295 (ange-ftp-this-user user)
2296 (ange-ftp-this-host host)
2297 (ange-ftp-this-msg msg)
2305 ;; cmd == 'dir "remote-name" "local-name" "ls-switches"
2308 host-type (ange-ftp-host-type host user))
2310 (eq cmd0 'dir))
2312 (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist))
2316 ;; Need to deal with the HP-UX ftp bug. This should also allow us to
2332 ;; If the dir name contains a space, some ftp servers will
2338 (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
2342 (unless (memq host-type ange-ftp-dumb-host-types)
2355 ;; `ange-ftp-insert-directory' such that in this case it gets
2359 (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
2365 ange-ftp-fix-name-func-alist))
2387 ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
2391 (ange-ftp-raw-send-cmd
2392 (ange-ftp-get-process host user)
2398 (if result (ange-ftp-call-cont cont result line)
2399 (ange-ftp-raw-send-cmd
2400 (ange-ftp-get-process host user)
2406 (ange-ftp-call-cont cont result line))
2423 (defconst ange-ftp-cms-name-template
2427 (defconst ange-ftp-vms-name-template
2429 (defconst ange-ftp-mts-name-template
2431 (defconst ange-ftp-bs2000-filename-pubset-regexp
2434 (defconst ange-ftp-bs2000-filename-username-regexp
2438 (defconst ange-ftp-bs2000-filename-prefix-regexp
2440 ange-ftp-bs2000-filename-pubset-regexp
2441 ange-ftp-bs2000-filename-username-regexp)
2443 (defconst ange-ftp-bs2000-name-template
2444 (concat "^" ange-ftp-bs2000-filename-prefix-regexp "$"))
2446 (defun ange-ftp-guess-host-type (host user)
2449 (let ((host-type (ange-ftp-host-type host))
2452 ;; Note that ange-ftp-host-type returns unix as the default value.
2454 (let* ((result (ange-ftp-get-pwd host user))
2455 (dir (car result))
2457 (cond ((null dir)
2467 (ange-ftp-add-cms-host host)
2468 (setq ange-ftp-host-cache host
2469 ange-ftp-host-type-cache 'cms))))
2472 ((string-match ange-ftp-vms-name-template dir)
2473 (ange-ftp-add-vms-host host)
2476 (setq ange-ftp-host-cache host
2477 ange-ftp-host-type-cache 'vms))
2480 ((string-match ange-ftp-mts-name-template dir)
2481 (ange-ftp-add-mts-host host)
2482 (setq ange-ftp-host-cache host
2483 ange-ftp-host-type-cache 'mts))
2486 ((string-match ange-ftp-cms-name-template dir)
2487 (ange-ftp-add-cms-host host)
2488 (setq ange-ftp-host-cache host
2489 ange-ftp-host-type-cache 'cms))
2492 ((ange-ftp-bs2000-posix-host host)
2493 (ange-ftp-add-bs2000-host host)
2494 (setq ange-ftp-host-cache host
2495 ange-ftp-host-type-cache 'text-unix))
2497 ((and (string-match ange-ftp-bs2000-name-template dir)
2498 (not (ange-ftp-bs2000-posix-host host)))
2499 (ange-ftp-add-bs2000-host host)
2500 (setq ange-ftp-host-cache host
2501 ange-ftp-host-type-cache 'bs2000))
2504 (setq ange-ftp-host-cache host
2505 ange-ftp-host-type-cache 'unix)))
2508 ;; the expand-dir hashtable.
2509 (let ((ange-ftp-this-user user)
2510 (ange-ftp-this-host host))
2511 (setq fix-name-func (cdr (assq ange-ftp-host-type-cache
2512 ange-ftp-fix-name-func-alist)))
2514 (setq dir (funcall fix-name-func dir 'reverse))))
2515 (puthash key dir ange-ftp-expand-dir-hashtable))))
2521 (not (ange-ftp-hash-entry-exists-p
2522 key ange-ftp-expand-dir-hashtable)))
2523 (let ((dir (car (ange-ftp-get-pwd host user))))
2524 (if dir
2525 (puthash key (concat "/" dir) ange-ftp-expand-dir-hashtable)
2535 ;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
2537 (defun ange-ftp-dumb-unix-host (host)
2538 (and host ange-ftp-dumb-unix-host-regexp
2540 (string-match ange-ftp-dumb-unix-host-regexp host))))
2542 (defun ange-ftp-add-dumb-unix-host (host)
2543 "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp."
2547 (and name (car (ange-ftp-ftp-name name)))))))
2548 (if (not (ange-ftp-dumb-unix-host host))
2549 (setq ange-ftp-dumb-unix-host-regexp
2551 (and ange-ftp-dumb-unix-host-regexp "\\|")
2552 ange-ftp-dumb-unix-host-regexp)
2553 ange-ftp-host-cache nil)))
2555 (defvar ange-ftp-parse-list-func-alist nil
2561 ;; an error if file is not an ange-ftp-name
2563 ;; an error if either the listing is unreadable or there is an ftp error.
2567 ;; an error if not an ange-ftp-name
2569 ;; nil if ftp error (this is because although asking to list a nonexistent
2572 ;; ftp error, if the same is done on a VMS machine,
2573 ;; an ftp error is returned. Need to trap the error
2581 (defvar ange-ftp-before-parse-ls-hook nil
2582 "Normal hook run before parsing the text of an ftp directory listing.")
2584 (defvar ange-ftp-after-parse-ls-hook nil
2585 "Normal hook run after parsing the text of an ftp directory listing.")
2587 (defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
2588 "Return the output of a `DIR' or `ls' command done over ftp.
2596 (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file))
2597 (parsed (ange-ftp-ftp-name ange-ftp-this-file)))
2601 (name (ange-ftp-quote-string (nth 2 parsed)))
2602 (key (directory-file-name ange-ftp-this-file))
2603 (host-type (ange-ftp-host-type host user))
2604 (dumb (memq host-type ange-ftp-dumb-host-types))
2610 (ange-ftp-real-file-name-as-directory
2611 (ange-ftp-expand-dir host user "~"))))
2612 (if (and ange-ftp-ls-cache-file
2613 (string-equal key ange-ftp-ls-cache-file)
2615 (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs)))
2616 ange-ftp-ls-cache-res
2617 (setq temp (ange-ftp-make-tmp-name host))
2620 (ange-ftp-cd host user (file-name-directory name))
2622 (setq lscmd (list 'dir name temp lsargs)))
2624 (if (car (setq result (ange-ftp-send-cmd
2629 (ange-ftp-abbreviate-filename
2630 ange-ftp-this-file)))))
2632 ange-ftp-data-buffer-name)
2634 (if (ange-ftp-real-file-readable-p temp)
2635 (ange-ftp-real-insert-file-contents temp)
2636 (sleep-for ange-ftp-retry-time)
2638 (if (ange-ftp-real-file-readable-p temp)
2640 (ange-ftp-real-insert-file-contents temp)
2641 (ange-ftp-error host user
2645 ;; remove ^M inserted by the win32 ftp client
2649 (run-hooks 'ange-ftp-before-parse-ls-hook)
2651 (ange-ftp-set-files
2652 ange-ftp-this-file
2656 ange-ftp-parse-list-func-alist)))
2658 (ange-ftp-parse-dired-listing lsargs))))
2663 (run-hooks 'ange-ftp-after-parse-ls-hook)
2664 (setq ange-ftp-ls-cache-file key
2665 ange-ftp-ls-cache-lsargs lsargs
2668 ange-ftp-ls-cache-res (buffer-string))
2670 (if (equal ange-ftp-ls-cache-res "total 0\n")
2673 ;; `DIR /some/file/.' which leads ange-ftp to
2676 ange-ftp-ls-cache-res))
2679 (ange-ftp-error host user
2681 (ange-ftp-del-tmp-name temp))))
2689 (defvar ange-ftp-add-file-entry-alist nil
2695 (defvar ange-ftp-delete-file-entry-alist nil
2701 (defun ange-ftp-add-file-entry (name &optional dir-p)
2703 (funcall (or (cdr (assq (ange-ftp-host-type
2704 (car (ange-ftp-ftp-name name)))
2705 ange-ftp-add-file-entry-alist))
2706 'ange-ftp-internal-add-file-entry)
2707 name dir-p)
2708 (setq ange-ftp-ls-cache-file nil))
2710 (defun ange-ftp-delete-file-entry (name &optional dir-p)
2712 (funcall (or (cdr (assq (ange-ftp-host-type
2713 (car (ange-ftp-ftp-name name)))
2714 ange-ftp-delete-file-entry-alist))
2715 'ange-ftp-internal-delete-file-entry)
2716 name dir-p)
2717 (setq ange-ftp-ls-cache-file nil))
2719 (defmacro ange-ftp-parse-filename ()
2730 (defun ange-ftp-ls-parser (switches)
2731 ;; Meant to be called by ange-ftp-parse-dired-listing
2736 (while (setq file (ange-ftp-parse-filename))
2780 (defvar ange-ftp-dl-dir-regexp nil
2785 (defun ange-ftp-add-dl-dir (dir)
2786 "Interactively adds a DIR to ange-ftp-dl-dir-regexp."
2790 (and name (ange-ftp-ftp-name name)
2792 (if (not (and ange-ftp-dl-dir-regexp
2793 (string-match ange-ftp-dl-dir-regexp dir)))
2794 (setq ange-ftp-dl-dir-regexp
2795 (concat "^" (regexp-quote dir)
2796 (and ange-ftp-dl-dir-regexp "\\|")
2797 ange-ftp-dl-dir-regexp))))
2799 (defmacro ange-ftp-dl-parser ()
2820 (defun ange-ftp-parse-dired-listing (&optional switches)
2827 (ange-ftp-ls-parser switches))
2841 (ange-ftp-ls-parser switches))
2844 ;; file is bound by the call to ange-ftp-ls
2845 (ange-ftp-add-dl-dir ange-ftp-this-file)
2847 (ange-ftp-dl-parser))
2850 (defun ange-ftp-set-files (directory files)
2853 files ange-ftp-files-hashtable)))
2855 (defun ange-ftp-get-files (directory &optional no-error)
2860 (or (gethash directory ange-ftp-files-hashtable)
2862 (and (ange-ftp-ls directory
2891 (gethash directory ange-ftp-files-hashtable)))))
2895 (defmacro ange-ftp-get-file-part (name)
2901 ;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
2910 (defmacro ange-ftp-allow-child-lookup (dir file)
2913 (edir ,dir)
2914 (parsed (ange-ftp-ftp-name edir))
2915 (host-type (ange-ftp-host-type
2922 ;; No dots in dir names in vms.
2928 ;; No dots in pseudo-dir names in bs2000.
2932 (defun ange-ftp-file-entry-p (name)
2935 (dir (file-name-directory name))
2936 (ent (gethash dir ange-ftp-files-hashtable))
2937 (file (ange-ftp-get-file-part name)))
2939 (ange-ftp-hash-entry-exists-p file ent)
2940 (or (and (ange-ftp-allow-child-lookup dir file)
2941 (setq ent (ange-ftp-get-files name t))
2943 ;; subdirectory of dir. This is a good idea because
2947 ;; then dumb hosts will give an ftp error. Smart unix hosts
2952 (ange-ftp-hash-entry-exists-p
2953 file (ange-ftp-get-files dir 'no-error))))))
2955 (defun ange-ftp-get-file-entry (name)
2961 (dir (file-name-directory name))
2962 (ent (gethash dir ange-ftp-files-hashtable))
2963 (file (ange-ftp-get-file-part name)))
2966 (or (and (ange-ftp-allow-child-lookup dir file)
2967 (setq ent (ange-ftp-get-files name t))
2970 (and (setq ent (ange-ftp-get-files dir t))
2973 (defun ange-ftp-internal-delete-file-entry (name &optional dir-p)
2974 (when dir-p
2976 (remhash name ange-ftp-files-hashtable)
2981 (let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable)))
2983 (remhash (ange-ftp-get-file-part name) files))))
2985 (defun ange-ftp-internal-add-file-entry (name &optional dir-p)
2986 (and dir-p
2988 (let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable)))
2990 (puthash (ange-ftp-get-file-part name) dir-p files))))
2992 (defun ange-ftp-wipe-file-entries (host user)
2996 ange-ftp-files-hashtable))))
2999 (let ((parsed (ange-ftp-ftp-name key)))
3005 ange-ftp-files-hashtable)
3006 (setq ange-ftp-files-hashtable new-tbl)))
3013 (defun ange-ftp-set-binary-mode (host user)
3014 "Tell the ftp process for the given HOST & USER to switch to binary mode."
3015 (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
3017 (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
3018 (with-current-buffer (process-buffer (ange-ftp-get-process host user))
3019 (and ange-ftp-binary-hash-mark-size
3020 (setq ange-ftp-hash-mark-unit
3021 (ash ange-ftp-binary-hash-mark-size -4)))))))
3023 (defun ange-ftp-set-ascii-mode (host user)
3024 "Tell the ftp process for the given HOST & USER to switch to ascii mode."
3025 (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
3027 (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
3028 (with-current-buffer (process-buffer (ange-ftp-get-process host user))
3029 (and ange-ftp-ascii-hash-mark-size
3030 (setq ange-ftp-hash-mark-unit
3031 (ash ange-ftp-ascii-hash-mark-size -4)))))))
3034 (defun ange-ftp-cd (host user dir &optional noerror)
3035 (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
3038 (ange-ftp-error host user (concat "CD failed: " (cdr result)))))))
3040 (defun ange-ftp-get-pwd (host user)
3044 (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
3046 dir)
3051 (setq dir (match-string 1 line)))))
3052 (cons dir line)))
3059 (defun ange-ftp-expand-dir (host user dir)
3063 (let* ((host-type (ange-ftp-host-type host user))
3064 ;; It is more efficient to call ange-ftp-host-type
3065 ;; before binding res, because ange-ftp-host-type sometimes
3066 ;; adds to the info in the expand-dir-hashtable.
3068 (cdr (assq host-type ange-ftp-fix-name-func-alist)))
3069 (key (concat host "/" user "/" dir))
3070 (res (gethash key ange-ftp-expand-dir-hashtable)))
3075 (string-equal user "ftp")
3077 (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp
3079 ange-ftp-good-msgs))
3080 (result (ange-ftp-send-cmd host user
3081 (list 'get dir null-device)
3082 (format "expanding %s" dir)))
3085 (if (string-match ange-ftp-expand-dir-regexp line)
3088 (if (string-equal dir "~")
3089 (setq res (car (ange-ftp-get-pwd host user)))
3090 (let ((home (ange-ftp-expand-dir host user "~")))
3092 (and (ange-ftp-cd host user dir)
3093 (setq res (car (ange-ftp-get-pwd host user))))
3094 (ange-ftp-cd host user home)))))
3096 (let ((ange-ftp-this-user user)
3097 (ange-ftp-this-host host))
3100 (puthash key res ange-ftp-expand-dir-hashtable)))
3103 (defun ange-ftp-canonize-filename (n)
3107 (let ((parsed (ange-ftp-ftp-name n)))
3123 (dir (ange-ftp-expand-dir host user tilda)))
3124 (if dir
3125 ;; C-x d /ftp:anonymous@ftp.gnu.org:~/ RET
3130 (setq name (cond ((string-equal rest "") dir)
3131 ((string-equal dir "/") rest)
3132 (t (concat dir rest))))
3138 (let ((dir (ange-ftp-expand-dir host user "~")))
3139 (if dir
3141 (ange-ftp-real-file-name-as-directory dir)
3148 (setq name (ange-ftp-real-expand-file-name name))
3149 ;; Windows UNC default dirs do not make sense for ftp.
3151 (ange-ftp-real-expand-file-name name "c:/")
3152 (ange-ftp-real-expand-file-name name)))
3160 (ange-ftp-replace-name-component n name))
3162 ;; non-ange-ftp name. Just expand normally.
3164 (ange-ftp-real-expand-file-name n)
3165 (ange-ftp-real-expand-file-name
3166 (ange-ftp-real-file-name-nondirectory n)
3167 (ange-ftp-real-file-name-directory n))))))
3169 (defun ange-ftp-expand-file-name (name &optional default)
3174 (ange-ftp-real-expand-file-name name))
3176 (ange-ftp-canonize-filename name))
3179 (ange-ftp-canonize-filename name))
3183 (ange-ftp-real-expand-file-name name default))
3185 (ange-ftp-canonize-filename default))
3186 ((ange-ftp-canonize-filename
3192 (defvar ange-ftp-file-name-as-directory-alist nil
3197 (defun ange-ftp-file-name-as-directory (name)
3199 (let ((parsed (ange-ftp-ftp-name name)))
3204 (ange-ftp-host-type (car parsed))
3205 ange-ftp-file-name-as-directory-alist))
3206 'ange-ftp-real-file-name-as-directory)
3208 (ange-ftp-real-file-name-as-directory name))))
3210 (defun ange-ftp-file-name-directory (name)
3212 (let ((parsed (ange-ftp-ftp-name name)))
3218 (ange-ftp-replace-name-component
3220 (ange-ftp-real-file-name-directory filename))))
3221 (ange-ftp-real-file-name-directory name))))
3223 (defun ange-ftp-file-name-nondirectory (name)
3225 (let ((parsed (ange-ftp-ftp-name name)))
3231 (ange-ftp-real-file-name-nondirectory filename)))
3232 (ange-ftp-real-file-name-nondirectory name))))
3234 (defun ange-ftp-directory-file-name (dir)
3236 (let ((parsed (ange-ftp-ftp-name dir)))
3238 (ange-ftp-replace-name-component
3239 dir
3240 (ange-ftp-real-directory-file-name (nth 2 parsed)))
3241 (ange-ftp-real-directory-file-name dir))))
3248 (defun ange-ftp-binary-file (file)
3250 (string-match ange-ftp-binary-file-name-regexp file)))
3252 (defun ange-ftp-write-region (start end filename &optional append visit)
3254 (let ((parsed (ange-ftp-ftp-name filename)))
3258 (name (ange-ftp-quote-string (nth 2 parsed)))
3259 (temp (ange-ftp-make-tmp-name host))
3263 (binary (or (ange-ftp-binary-file filename)
3266 (memq (ange-ftp-host-type host user)
3269 (abbr (ange-ftp-abbreviate-filename filename))
3273 ;; might be used when communicating with the ftp process.
3281 (ange-ftp-real-write-region start end temp nil
3289 (ange-ftp-set-binary-mode host user))
3294 (ange-ftp-set-xfer-size host user (nth 7 attr))))
3297 (let ((result (ange-ftp-send-cmd host user
3301 (signal 'ftp-error
3306 (ange-ftp-del-tmp-name temp)
3308 (ange-ftp-set-ascii-mode host user)))
3311 (set-visited-file-modtime (ange-ftp-file-modtime filename))
3312 (ange-ftp-set-buffer-mode)
3317 (ange-ftp-message "Wrote %s" abbr)
3318 (ange-ftp-add-file-entry filename))
3319 (ange-ftp-real-write-region start end filename append visit))))
3321 (defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
3324 (let ((parsed (ange-ftp-ftp-name filename)))
3331 (setq ange-ftp-ls-cache-file nil)
3333 ange-ftp-files-hashtable)
3337 (name (ange-ftp-quote-string (nth 2 parsed)))
3338 (temp (ange-ftp-make-tmp-name host))
3339 (binary (or (ange-ftp-binary-file filename)
3340 (memq (ange-ftp-host-type host user)
3342 (abbr (ange-ftp-abbreviate-filename filename))
3348 (ange-ftp-set-binary-mode host user))
3349 (let ((result (ange-ftp-send-cmd host user
3353 (signal 'ftp-error
3358 (if (or (ange-ftp-real-file-readable-p temp)
3359 (sleep-for ange-ftp-retry-time)
3361 (ange-ftp-real-file-readable-p temp))
3364 (nth 1 (ange-ftp-real-insert-file-contents
3370 (signal 'ftp-error
3380 (ange-ftp-set-ascii-mode host user)))
3381 (ange-ftp-del-tmp-name temp))
3385 (ange-ftp-file-modtime filename))
3393 (ange-ftp-real-insert-file-contents filename visit beg end replace))))
3395 (defun ange-ftp-expand-symlink (file dir)
3397 (ange-ftp-replace-name-component dir file)
3398 (expand-file-name file dir))))
3400 (ange-ftp-expand-symlink
3401 (ange-ftp-get-file-entry res)
3405 (defun ange-ftp-file-symlink-p (file)
3406 ;; call ange-ftp-expand-file-name rather than the normal
3409 (setq file (ange-ftp-expand-file-name file))
3410 (if (ange-ftp-ftp-name file)
3412 (let ((ent (ange-ftp-get-files (file-name-directory file))))
3415 (gethash (ange-ftp-get-file-part file) ent)))
3422 (ange-ftp-real-file-symlink-p file)))
3424 (defun ange-ftp-file-exists-p (name)
3426 (if (ange-ftp-ftp-name name)
3427 (if (ange-ftp-file-entry-p name)
3428 (let ((file-ent (ange-ftp-get-file-entry name)))
3431 (ange-ftp-expand-symlink file-ent
3435 (ange-ftp-real-file-exists-p name)))
3437 (defun ange-ftp-file-directory-p (name)
3439 (if (ange-ftp-ftp-name name)
3443 (let ((file-ent (ange-ftp-get-file-entry
3444 (ange-ftp-file-name-as-directory name))))
3446 ;; Calling file-directory-p doesn't work because ange-ftp
3448 (ange-ftp-file-directory-p
3449 (ange-ftp-expand-symlink file-ent
3453 (ange-ftp-real-file-directory-p name)))
3455 (defun ange-ftp-directory-files (directory &optional full match
3458 (if (ange-ftp-ftp-name directory)
3460 (ange-ftp-barf-if-not-directory directory)
3461 (let ((tail (ange-ftp-hash-table-keys
3462 (ange-ftp-get-files directory)))
3473 (apply 'ange-ftp-real-directory-files directory full match v19-args)))
3475 (defun ange-ftp-file-attributes (file &optional id-format)
3477 (let ((parsed (ange-ftp-ftp-name file)))
3479 (let ((part (ange-ftp-get-file-part file))
3480 (files (ange-ftp-get-files (file-name-directory file))))
3481 (if (ange-ftp-hash-entry-exists-p part files)
3486 (inode (gethash file ange-ftp-inodes-hashtable)))
3488 (setq inode ange-ftp-next-inode-number
3489 ange-ftp-next-inode-number (1+ inode))
3490 (puthash file inode ange-ftp-inodes-hashtable))
3492 (ange-ftp-expand-symlink dirp
3499 (ange-ftp-file-modtime file) ;5 mtime
3509 (ange-ftp-real-file-attributes file id-format)
3510 (ange-ftp-real-file-attributes file)))))
3512 (defun ange-ftp-file-newer-than-file-p (f1 f2)
3513 (let ((f1-parsed (ange-ftp-ftp-name f1))
3514 (f2-parsed (ange-ftp-ftp-name f2)))
3521 (ange-ftp-real-file-newer-than-file-p f1 f2))))
3523 (defun ange-ftp-file-writable-p (file)
3524 (let ((ange-ftp-process-verbose nil))
3526 (if (ange-ftp-ftp-name file)
3529 (ange-ftp-real-file-writable-p file))))
3531 (defun ange-ftp-file-readable-p (file)
3532 (let ((ange-ftp-process-verbose nil))
3534 (if (ange-ftp-ftp-name file)
3536 (ange-ftp-real-file-readable-p file))))
3538 (defun ange-ftp-file-executable-p (file)
3539 (let ((ange-ftp-process-verbose nil))
3541 (if (ange-ftp-ftp-name file)
3543 (ange-ftp-real-file-executable-p file))))
3545 (defun ange-ftp-delete-file (file)
3548 (let ((parsed (ange-ftp-ftp-name file)))
3552 (name (ange-ftp-quote-string (nth 2 parsed)))
3553 (abbr (ange-ftp-abbreviate-filename file))
3554 (result (ange-ftp-send-cmd host user
3558 (signal 'ftp-error
3563 (ange-ftp-delete-file-entry file))
3564 (ange-ftp-real-delete-file file))))
3566 (defun ange-ftp-file-modtime (file)
3569 (let* ((parsed (ange-ftp-ftp-name file))
3573 (ange-ftp-skip-msgs (concat ange-ftp-skip-msgs "\\|^226"))
3574 (res (ange-ftp-send-cmd (car parsed) (cadr parsed)
3595 (defun ange-ftp-verify-visited-file-modtime (buf)
3597 (if (and (stringp name) (ange-ftp-ftp-name name))
3598 (let ((file-mdtm (ange-ftp-file-modtime name))
3602 (ange-ftp-real-verify-visited-file-modtime buf))))
3609 (defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
3620 ;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
3627 ;; (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
3635 ;; (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel)
3640 ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
3647 ;; (ange-ftp-call-cont cont t nil)
3648 ;; (ange-ftp-call-cont cont
3655 ;; this is the extended version of ange-ftp-copy-file-internal that works
3657 (defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
3666 (let ((f-parsed (ange-ftp-ftp-name filename))
3667 (t-parsed (ange-ftp-ftp-name newname)))
3672 (ange-ftp-real-copy-file filename newname ok-if-already-exists
3675 (ange-ftp-call-cont cont t "Copied locally")))
3679 (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
3680 (f-abbr (ange-ftp-abbreviate-filename filename))
3683 (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
3684 (t-abbr (ange-ftp-abbreviate-filename newname filename))
3685 (binary (or (ange-ftp-binary-file filename)
3686 (ange-ftp-binary-file newname)
3687 (and (memq (ange-ftp-host-type f-host f-user)
3689 (memq (ange-ftp-host-type t-host t-user)
3697 (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
3705 (if (or (ange-ftp-use-gateway-p f-host)
3709 (setq temp1 (ange-ftp-make-tmp-name f-host)))
3712 (ange-ftp-set-binary-mode f-host f-user))
3714 (ange-ftp-send-cmd
3717 (list 'get f-name (or temp1 (ange-ftp-quote-string newname)))
3722 (list 'ange-ftp-cf1
3731 (ange-ftp-cf1 t nil
3737 (defvar ange-ftp-waiting-flag nil)
3740 (defun ange-ftp-cf1 (result line
3751 (and temp1 (ange-ftp-del-tmp-name temp1))
3753 (if ange-ftp-waiting-flag
3754 (throw 'ftp-error t)
3755 (signal 'ftp-error
3761 (ange-ftp-set-ascii-mode f-host f-user))))
3769 (if (ange-ftp-use-gateway-p t-host)
3770 (setq temp2 (ange-ftp-make-tmp-name t-host)))
3779 (ange-ftp-real-copy-file temp1 temp2 t))
3782 (ange-ftp-real-copy-file filename temp2 t)))
3785 (ange-ftp-set-binary-mode t-host t-user))
3790 (ange-ftp-set-xfer-size t-host t-user (nth 7 attr))))
3792 (ange-ftp-send-cmd
3800 (list 'ange-ftp-cf2
3805 (ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
3808 (ange-ftp-call-cont cont result line)))
3811 (defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont)
3819 (if ange-ftp-waiting-flag
3820 (throw 'ftp-error t)
3821 (signal 'ftp-error
3826 (ange-ftp-add-file-entry newname))
3830 (ange-ftp-set-ascii-mode t-host t-user)))
3834 (ange-ftp-real-copy-file temp1 newname t)))
3837 (and temp1 (ange-ftp-del-tmp-name temp1))
3838 (and temp2 (ange-ftp-del-tmp-name temp2))
3839 (ange-ftp-call-cont cont result line)))
3841 (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
3844 (ange-ftp-copy-file-internal filename
3852 (defun ange-ftp-copy-files-async (okay-p line verbose-p files)
3856 function a valid CONT argument for `ange-ftp-raw-send-cmd'.
3862 (ange-ftp-copy-files-async t nil t '((\"a\" \"b\" t t) (\"c\" \"d\" t t)))"
3863 (unless okay-p (error "%s: %s" 'ange-ftp-copy-files-async line))
3870 (ange-ftp-copy-file-internal
3873 (list 'ange-ftp-copy-files-async verbose-p (cdr files))
3875 (message "%s: done" 'ange-ftp-copy-files-async)))
3883 (defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed)
3891 (let* ((f-name (ange-ftp-quote-string (nth 2 f-parsed)))
3892 (t-name (ange-ftp-quote-string (nth 2 t-parsed)))
3894 (fabbr (ange-ftp-abbreviate-filename filename))
3895 (nabbr (ange-ftp-abbreviate-filename newname filename))
3896 (result (ange-ftp-send-cmd f-host f-user cmd
3901 (signal 'ftp-error
3907 (ange-ftp-add-file-entry newname)
3908 (ange-ftp-delete-file-entry filename))
3909 (ange-ftp-copy-file-internal filename newname t nil)
3912 (defun ange-ftp-rename-local-to-remote (filename newname)
3914 (let* ((fabbr (ange-ftp-abbreviate-filename filename))
3915 (nabbr (ange-ftp-abbreviate-filename newname filename))
3917 (ange-ftp-copy-file-internal filename newname t nil msg)
3918 (let (ange-ftp-process-verbose)
3921 (defun ange-ftp-rename-remote-to-local (filename newname)
3923 (let* ((fabbr (ange-ftp-abbreviate-filename filename))
3924 (nabbr (ange-ftp-abbreviate-filename newname filename))
3926 (ange-ftp-copy-file-internal filename newname t nil msg)
3927 (let (ange-ftp-process-verbose)
3930 (defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
3934 (let* ((f-parsed (ange-ftp-ftp-name filename))
3935 (t-parsed (ange-ftp-ftp-name newname)))
3939 (ange-ftp-barf-or-query-if-file-exists
3945 (ange-ftp-rename-remote-to-remote filename newname f-parsed
3947 (ange-ftp-rename-remote-to-local filename newname))
3949 (ange-ftp-rename-local-to-remote filename newname)
3950 (ange-ftp-real-rename-file filename newname ok-if-already-exists)))))
3960 ;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern'
3962 (defun ange-ftp-file-entry-not-ignored-p (symname val)
3964 (let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir)))
3967 (not (string-match ange-ftp-completion-ignored-pattern
3970 (not (string-match ange-ftp-completion-ignored-pattern symname)))))
3972 (defun ange-ftp-root-dir-p (dir)
3974 ;; (equal dir (file-name-directory (directory-file-name dir))) -stef
3976 (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
3977 (string-equal "/" dir)))
3979 (defun ange-ftp-file-name-all-completions (file dir)
3980 (let ((ange-ftp-this-dir (expand-file-name dir)))
3981 (if (ange-ftp-ftp-name ange-ftp-this-dir)
3983 (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
3984 (setq ange-ftp-this-dir
3985 (ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
3986 (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
3996 (ange-ftp-expand-symlink ent
3997 ange-ftp-this-dir))))
4002 (if (ange-ftp-root-dir-p ange-ftp-this-dir)
4003 (nconc (all-completions file (ange-ftp-generate-root-prefixes))
4004 (ange-ftp-real-file-name-all-completions file
4005 ange-ftp-this-dir))
4006 (ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
4008 (defun ange-ftp-file-name-completion (file dir &optional predicate)
4009 (let ((ange-ftp-this-dir (expand-file-name dir)))
4010 (if (ange-ftp-ftp-name ange-ftp-this-dir)
4012 (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
4015 (setq ange-ftp-this-dir
4016 (ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) ;real?
4017 (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
4018 (ange-ftp-completion-ignored-pattern
4025 (or (ange-ftp-file-name-completion-1
4026 file tbl ange-ftp-this-dir
4027 'ange-ftp-file-entry-not-ignored-p)
4028 (ange-ftp-file-name-completion-1
4029 file tbl ange-ftp-this-dir))))))
4031 (if (ange-ftp-root-dir-p ange-ftp-this-dir)
4034 (nconc (ange-ftp-generate-root-prefixes)
4035 (ange-ftp-real-file-name-all-completions
4036 file ange-ftp-this-dir))
4039 (ange-ftp-real-file-name-completion
4040 file ange-ftp-this-dir predicate)
4041 (ange-ftp-real-file-name-completion
4042 file ange-ftp-this-dir))))))
4045 (defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate)
4049 (if (file-directory-p (expand-file-name file dir))
4054 (expand-file-name bestmatch dir)))
4059 ;; ange-ftp's cache whilst doing filename completion.
4061 ;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
4062 ;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
4065 (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
4068 (defun ange-ftp-reread-dir (&optional dir)
4070 The implementation of remote ftp file names caches directory contents
4072 may not know they exist. You can use this command to reread a specific
4075 (if dir
4076 (setq dir (expand-file-name dir))
4077 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
4078 (if (ange-ftp-ftp-name dir)
4080 (setq ange-ftp-ls-cache-file nil)
4081 (remhash dir ange-ftp-files-hashtable)
4082 (ange-ftp-get-files dir t))))
4085 (defun ange-ftp-make-directory (dir &optional parents)
4088 (let ((parent (file-name-directory (directory-file-name dir))))
4090 (ange-ftp-make-directory parent parents))))
4091 (if (file-exists-p dir)
4092 (error "Cannot make directory %s: file already exists" dir)
4093 (let ((parsed (ange-ftp-ftp-name dir)))
4097 ;; Some ftp's on unix machines (at least on Suns)
4102 ;; (as the ftp man page says it should).
4103 (name (ange-ftp-quote-string
4104 (if (eq (ange-ftp-host-type host) 'unix)
4105 (ange-ftp-real-directory-file-name (nth 2 parsed))
4106 (ange-ftp-real-file-name-as-directory
4108 (abbr (ange-ftp-abbreviate-filename dir))
4109 (result (ange-ftp-send-cmd host user
4114 (ange-ftp-error host user
4116 dir
4118 (ange-ftp-add-file-entry dir t))
4119 (ange-ftp-real-make-directory dir)))))
4121 (defun ange-ftp-delete-directory (dir)
4122 (if (file-directory-p dir)
4123 (let ((parsed (ange-ftp-ftp-name dir)))
4127 ;; Some ftp's on unix machines (at least on Suns)
4132 ;; (as the ftp man page says it should).
4133 (name (ange-ftp-quote-string
4134 (if (eq (ange-ftp-host-type host) 'unix)
4135 (ange-ftp-real-directory-file-name
4137 (ange-ftp-real-file-name-as-directory
4139 (abbr (ange-ftp-abbreviate-filename dir))
4140 (result (ange-ftp-send-cmd host user
4145 (ange-ftp-error host user
4147 dir
4149 (ange-ftp-delete-file-entry dir t))
4150 (ange-ftp-real-delete-directory dir)))
4151 (error "Not a directory: %s" dir)))
4156 (defun ange-ftp-file-local-copy (file)
4158 (pa1 (ange-ftp-ftp-name fn1)))
4160 (let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
4161 (ange-ftp-copy-file-internal fn1 tmp1 t nil
4165 (defun ange-ftp-file-remote-p (file)
4166 (ange-ftp-replace-name-component file ""))
4168 (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
4169 (if (ange-ftp-ftp-name file)
4177 (catch 'ftp-error
4178 (let ((ange-ftp-waiting-flag t))
4180 (setq copy (ange-ftp-file-local-copy (car tryfiles)))
4181 (ftp-error nil))))
4190 (ange-ftp-real-load file noerror nomessage nosuffix)))
4192 ;; Calculate default-unhandled-directory for a given ange-ftp buffer.
4193 (defun ange-ftp-unhandled-file-name-directory (filename)
4194 (file-name-directory ange-ftp-tmp-name-template))
4202 (defvar ange-ftp-make-compressed-filename-alist nil
4211 (defun ange-ftp-dired-compress-file (name)
4212 (let ((parsed (ange-ftp-ftp-name name))
4216 (cdr (assq (ange-ftp-host-type (car parsed))
4217 ange-ftp-make-compressed-filename-alist))))
4223 (ange-ftp-compress name newfile)
4224 (ange-ftp-uncompress name newfile)))
4229 (defun ange-ftp-compress (file nfile)
4230 (let* ((parsed (ange-ftp-ftp-name file))
4231 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
4232 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
4233 (abbr (ange-ftp-abbreviate-filename file))
4234 (nabbr (ange-ftp-abbreviate-filename nfile))
4239 (ange-ftp-copy-file-internal file tmp1 t nil msg1)
4240 (and ange-ftp-process-verbose
4241 (ange-ftp-message "Compressing %s..." abbr))
4250 (and ange-ftp-process-verbose
4251 (ange-ftp-message "Compressing %s...done" abbr))
4254 (let (ange-ftp-process-verbose)
4256 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
4257 (ange-ftp-del-tmp-name tmp1)
4258 (ange-ftp-del-tmp-name tmp2))))
4261 (defun ange-ftp-uncompress (file nfile)
4262 (let* ((parsed (ange-ftp-ftp-name file))
4263 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
4264 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
4265 (abbr (ange-ftp-abbreviate-filename file))
4266 (nabbr (ange-ftp-abbreviate-filename nfile))
4271 ;; (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed)))))
4275 (ange-ftp-copy-file-internal file tmp1 t nil msg1)
4276 (and ange-ftp-process-verbose
4277 (ange-ftp-message "Uncompressing %s..." abbr))
4286 (and ange-ftp-process-verbose
4287 (ange-ftp-message "Uncompressing %s...done" abbr))
4290 (let (ange-ftp-process-verbose)
4292 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
4293 (ange-ftp-del-tmp-name tmp1)
4294 (ange-ftp-del-tmp-name tmp2))))
4296 (defun ange-ftp-find-backup-file-name (fn)
4299 (if ange-ftp-make-backup-files
4300 (ange-ftp-real-find-backup-file-name fn)))
4304 ;;; that causes ange-ftp to be invoked.
4307 (defun ange-ftp-hook-function (operation &rest args)
4308 (let ((fn (get operation 'ange-ftp)))
4310 (ange-ftp-run-real-handler operation args))))
4315 ;;-;;; This regexp takes care of real ange-ftp file names (with a slash
4321 ;;- (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
4329 ;;- (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
4340 ;;- ange-ftp-completion-hook-function)
4347 (add-hook 'find-file-hook 'ange-ftp-set-buffer-mode)
4351 (put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory)
4352 (put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory)
4353 (put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory)
4354 (put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name)
4355 (put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name)
4356 (put 'make-directory 'ange-ftp 'ange-ftp-make-directory)
4357 (put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
4358 (put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
4359 (put 'directory-files 'ange-ftp 'ange-ftp-directory-files)
4360 (put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
4361 (put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
4362 (put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
4363 (put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
4364 (put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
4365 (put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
4366 (put 'verify-visited-file-modtime 'ange-ftp
4367 'ange-ftp-verify-visited-file-modtime)
4368 (put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p)
4369 (put 'write-region 'ange-ftp 'ange-ftp-write-region)
4370 (put 'copy-file 'ange-ftp 'ange-ftp-copy-file)
4371 (put 'rename-file 'ange-ftp 'ange-ftp-rename-file)
4372 (put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
4373 (put 'file-newer-than-file-p 'ange-ftp 'ange-ftp-file-newer-than-file-p)
4374 (put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions)
4375 (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
4376 (put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
4377 (put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
4378 (put 'file-remote-p 'ange-ftp 'ange-ftp-file-remote-p)
4379 (put 'unhandled-file-name-directory 'ange-ftp
4380 'ange-ftp-unhandled-file-name-directory)
4381 (put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
4382 (put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
4383 (put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
4384 (put 'load 'ange-ftp 'ange-ftp-load)
4385 (put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
4389 (put 'file-truename 'ange-ftp 'identity)
4393 (put 'vc-registered 'ange-ftp 'null)
4395 (put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
4396 (put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
4402 (defun ange-ftp-run-real-handler (operation args)
4404 (cons 'ange-ftp-hook-function
4405 (cons 'ange-ftp-completion-hook-function
4411 (defun ange-ftp-real-file-name-directory (&rest args)
4412 (ange-ftp-run-real-handler 'file-name-directory args))
4413 (defun ange-ftp-real-file-name-nondirectory (&rest args)
4414 (ange-ftp-run-real-handler 'file-name-nondirectory args))
4415 (defun ange-ftp-real-file-name-as-directory (&rest args)
4416 (ange-ftp-run-real-handler 'file-name-as-directory args))
4417 (defun ange-ftp-real-directory-file-name (&rest args)
4418 (ange-ftp-run-real-handler 'directory-file-name args))
4419 (defun ange-ftp-real-expand-file-name (&rest args)
4420 (ange-ftp-run-real-handler 'expand-file-name args))
4421 (defun ange-ftp-real-make-directory (&rest args)
4422 (ange-ftp-run-real-handler 'make-directory args))
4423 (defun ange-ftp-real-delete-directory (&rest args)
4424 (ange-ftp-run-real-handler 'delete-directory args))
4425 (defun ange-ftp-real-insert-file-contents (&rest args)
4426 (ange-ftp-run-real-handler 'insert-file-contents args))
4427 (defun ange-ftp-real-directory-files (&rest args)
4428 (ange-ftp-run-real-handler 'directory-files args))
4429 (defun ange-ftp-real-file-directory-p (&rest args)
4430 (ange-ftp-run-real-handler 'file-directory-p args))
4431 (defun ange-ftp-real-file-writable-p (&rest args)
4432 (ange-ftp-run-real-handler 'file-writable-p args))
4433 (defun ange-ftp-real-file-readable-p (&rest args)
4434 (ange-ftp-run-real-handler 'file-readable-p args))
4435 (defun ange-ftp-real-file-executable-p (&rest args)
4436 (ange-ftp-run-real-handler 'file-executable-p args))
4437 (defun ange-ftp-real-file-symlink-p (&rest args)
4438 (ange-ftp-run-real-handler 'file-symlink-p args))
4439 (defun ange-ftp-real-delete-file (&rest args)
4440 (ange-ftp-run-real-handler 'delete-file args))
4441 (defun ange-ftp-real-verify-visited-file-modtime (&rest args)
4442 (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
4443 (defun ange-ftp-real-file-exists-p (&rest args)
4444 (ange-ftp-run-real-handler 'file-exists-p args))
4445 (defun ange-ftp-real-write-region (&rest args)
4446 (ange-ftp-run-real-handler 'write-region args))
4447 (defun ange-ftp-real-backup-buffer (&rest args)
4448 (ange-ftp-run-real-handler 'backup-buffer args))
4449 (defun ange-ftp-real-copy-file (&rest args)
4450 (ange-ftp-run-real-handler 'copy-file args))
4451 (defun ange-ftp-real-rename-file (&rest args)
4452 (ange-ftp-run-real-handler 'rename-file args))
4453 (defun ange-ftp-real-file-attributes (&rest args)
4454 (ange-ftp-run-real-handler 'file-attributes args))
4455 (defun ange-ftp-real-file-newer-than-file-p (&rest args)
4456 (ange-ftp-run-real-handler 'file-newer-than-file-p args))
4457 (defun ange-ftp-real-file-name-all-completions (&rest args)
4458 (ange-ftp-run-real-handler 'file-name-all-completions args))
4459 (defun ange-ftp-real-file-name-completion (&rest args)
4460 (ange-ftp-run-real-handler 'file-name-completion args))
4461 (defun ange-ftp-real-insert-directory (&rest args)
4462 (ange-ftp-run-real-handler 'insert-directory args))
4463 (defun ange-ftp-real-file-name-sans-versions (&rest args)
4464 (ange-ftp-run-real-handler 'file-name-sans-versions args))
4465 (defun ange-ftp-real-shell-command (&rest args)
4466 (ange-ftp-run-real-handler 'shell-command args))
4467 (defun ange-ftp-real-load (&rest args)
4468 (ange-ftp-run-real-handler 'load args))
4469 (defun ange-ftp-real-find-backup-file-name (&rest args)
4470 (ange-ftp-run-real-handler 'find-backup-file-name args))
4479 ;; The logical place to do this is in the functions ange-ftp-parse-...-listing.
4486 ;; `ange-ftp-ls' handles this.
4488 (defun ange-ftp-insert-directory (file switches &optional wildcard full)
4489 (if (not (ange-ftp-ftp-name (expand-file-name file)))
4490 (ange-ftp-real-insert-directory file switches wildcard full)
4493 ;; rather than the directory it points to. Now that ange-ftp-ls uses
4499 (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
4501 (ange-ftp-ls file switches 'parse))
4504 ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
4505 ;; then do an ls of current dir, which obviously won't work if we
4511 (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
4522 (defun ange-ftp-dired-uncache (dir)
4523 (if (ange-ftp-ftp-name (expand-file-name dir))
4524 (setq ange-ftp-ls-cache-file nil)))
4526 (defvar ange-ftp-sans-version-alist nil
4529 (defun ange-ftp-file-name-sans-versions (file keep-backup-version)
4530 (let* ((short (ange-ftp-abbreviate-filename file))
4531 (parsed (ange-ftp-ftp-name short))
4532 (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed))
4533 ange-ftp-sans-version-alist)))))
4535 (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
4538 (defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
4539 (let* ((parsed (ange-ftp-ftp-name default-directory))
4544 (ange-ftp-real-shell-command command output-buffer error-buffer)
4554 (ange-ftp-message "Remote command '%s' ..." command)
4555 ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
4557 ;; default-directory is in ange-ftp syntax for remote file names.
4558 (ange-ftp-real-shell-command command output-buffer error-buffer))))
4561 (defun ange-ftp-dired-call-process (program discard &rest arguments)
4564 (if (ange-ftp-ftp-name default-directory)
4565 ;; Can't use ange-ftp-dired-host-type here because the current
4569 (ange-ftp-call-chmod arguments))
4573 (ftp-error (insert (format "%s: %s, %s\n"
4584 ;; by using the ftp chmod command.
4585 (defun ange-ftp-call-chmod (args)
4587 (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
4595 (let ((parsed (ange-ftp-ftp-name file)))
4599 (name (ange-ftp-quote-string (nth 2 parsed)))
4600 (abbr (ange-ftp-abbreviate-filename file))
4601 (result (ange-ftp-send-cmd host user
4610 (setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
4616 ;; replace ange-ftp-copy-file.
4622 ;;(defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait)
4625 ;; (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil
4628 ;;(defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg
4632 ;; ;; we need to let ange-ftp-dired-create-files know that we indirectly
4634 ;; (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is
4635 ;; (ange-ftp-real-dired-do-create-files op-symbol file-creator operation
4638 ;;(defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor
4641 ;; (if (and (boundp 'ange-ftp-dired-do-create-files)
4642 ;; ;; called from ange-ftp-dired-do-create-files?
4643 ;; ange-ftp-dired-do-create-files
4650 ;; (or (ange-ftp-ftp-name (car fn-list))
4654 ;; (ange-ftp-ftp-name (funcall name-constructor (car fn-list)))))
4656 ;; (ange-ftp-dcf-1 file-creator
4671 ;; (ange-ftp-real-dired-create-files file-creator operation fn-list
4674 ;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
4680 ;; (ange-ftp-dcf-3 failures operation total skipped
4691 ;; (ange-ftp-dcf-1 file-creator
4722 ;; (list 'ange-ftp-dcf-2
4737 ;; (ange-ftp-dcf-2 nil ;result
4752 ;;(defun ange-ftp-dcf-2 (result line err
4779 ;; (ange-ftp-dcf-1 file-creator operation (cdr fn-list)
4789 ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
4816 ;;(defconst ange-ftp-dired-dl-re-dir
4820 ;;(or (assq 'unix:dl ange-ftp-dired-re-dir-alist)
4821 ;; (setq ange-ftp-dired-re-dir-alist
4822 ;; (cons (cons 'unix:dl ange-ftp-dired-dl-re-dir)
4823 ;; ange-ftp-dired-re-dir-alist)))
4825 ;;(defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol)
4837 ;;(or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist)
4838 ;; (setq ange-ftp-dired-move-to-filename-alist
4839 ;; (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename)
4840 ;; ange-ftp-dired-move-to-filename-alist)))
4842 ;;(defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol)
4866 ;;(or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist)
4867 ;; (setq ange-ftp-dired-move-to-end-of-filename-alist
4868 ;; (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename)
4869 ;; ange-ftp-dired-move-to-end-of-filename-alist)))
4877 ;(defun ange-ftp-fix-name-for-vos (name &optional reverse)
4888 ;(or (assq 'vos ange-ftp-fix-name-func-alist)
4889 ; (setq ange-ftp-fix-name-func-alist
4890 ; (cons '(vos . ange-ftp-fix-name-for-vos)
4891 ; ange-ftp-fix-name-func-alist)))
4893 ;(or (memq 'vos ange-ftp-dumb-host-types)
4894 ; (setq ange-ftp-dumb-host-types
4895 ; (cons 'vos ange-ftp-dumb-host-types)))
4897 ;(defun ange-ftp-fix-dir-name-for-vos (dir-name)
4898 ; (ange-ftp-fix-name-for-vos
4899 ; (concat dir-name
4900 ; (if (eq ?/ (aref dir-name (1- (length dir-name))))
4904 ;(or (assq 'vos ange-ftp-fix-dir-name-func-alist)
4905 ; (setq ange-ftp-fix-dir-name-func-alist
4906 ; (cons '(vos . ange-ftp-fix-dir-name-for-vos)
4907 ; ange-ftp-fix-dir-name-func-alist)))
4909 ;(defvar ange-ftp-vos-host-regexp nil
4912 ;(defun ange-ftp-vos-host (host)
4913 ; (and ange-ftp-vos-host-regexp
4915 ; (string-match ange-ftp-vos-host-regexp host))))
4917 ;(defun ange-ftp-parse-vos-listing ()
4920 ; (let ((tbl (ange-ftp-make-hashtable))
4924 ; type-regexp type-is-dir type-col file)
4929 ; type-is-dir (nth 1 (car type-list))
4939 ; (puthash file type-is-dir tbl)
4945 ;(or (assq 'vos ange-ftp-parse-list-func-alist)
4946 ; (setq ange-ftp-parse-list-func-alist
4947 ; (cons '(vos . ange-ftp-parse-vos-listing)
4948 ; ange-ftp-parse-list-func-alist)))
4957 (defun ange-ftp-fix-name-for-vms (name &optional reverse)
4961 (let (drive dir file)
4963 (setq dir (match-string 2 name))
4965 (and dir
4966 (setq dir (subst-char-in-string
4967 ?/ ?. (substring dir 1 -1) t)))
4970 dir (and dir "/")
4973 (let (drive dir file tmp)
4980 (setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t)))
4983 (and dir (concat "[" (if drive nil ".") dir "]"))
4986 ;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
4987 ;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
4989 (or (assq 'vms ange-ftp-fix-name-func-alist)
4990 (setq ange-ftp-fix-name-func-alist
4991 (cons '(vms . ange-ftp-fix-name-for-vms)
4992 ange-ftp-fix-name-func-alist)))
4994 (or (memq 'vms ange-ftp-dumb-host-types)
4995 (setq ange-ftp-dumb-host-types
4996 (cons 'vms ange-ftp-dumb-host-types)))
5006 (defun ange-ftp-fix-dir-name-for-vms (dir-name)
5010 (cond ((string-equal dir-name "/")
5012 ((string-match "\\`/[-A-Z0-9_$]+:/\\'" dir-name)
5014 ((ange-ftp-fix-name-for-vms dir-name))))
5016 (or (assq 'vms ange-ftp-fix-dir-name-func-alist)
5017 (setq ange-ftp-fix-dir-name-func-alist
5018 (cons '(vms . ange-ftp-fix-dir-name-for-vms)
5019 ange-ftp-fix-dir-name-func-alist)))
5021 (defvar ange-ftp-vms-host-regexp nil)
5024 (defun ange-ftp-vms-host (host)
5025 (and ange-ftp-vms-host-regexp
5027 (string-match ange-ftp-vms-host-regexp host))))
5029 ;; Because some VMS ftp servers convert filenames to lower case
5032 (defconst ange-ftp-vms-filename-regexp
5042 ;; of ftp listings from VMS hosts is a bit erratic. What saves us is that
5048 (defun ange-ftp-parse-vms-filename ()
5050 ange-ftp-vms-filename-regexp
5054 ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
5056 (defun ange-ftp-parse-vms-listing ()
5061 (while (setq file (ange-ftp-parse-vms-filename))
5062 (if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
5078 (add-to-list 'ange-ftp-parse-list-func-alist
5079 '(vms . ange-ftp-parse-vms-listing))
5087 (defun ange-ftp-vms-delete-file-entry (name &optional dir-p)
5088 (if dir-p
5089 (ange-ftp-internal-delete-file-entry name t)
5091 (let ((file (ange-ftp-get-file-part name)))
5097 ange-ftp-files-hashtable)))
5117 (or (assq 'vms ange-ftp-delete-file-entry-alist)
5118 (setq ange-ftp-delete-file-entry-alist
5119 (cons '(vms . ange-ftp-vms-delete-file-entry)
5120 ange-ftp-delete-file-entry-alist)))
5122 (defun ange-ftp-vms-add-file-entry (name &optional dir-p)
5123 (if dir-p
5124 (ange-ftp-internal-add-file-entry name t)
5126 ange-ftp-files-hashtable)))
5128 (let ((file (ange-ftp-get-file-part name)))
5151 (or (assq 'vms ange-ftp-add-file-entry-alist)
5152 (setq ange-ftp-add-file-entry-alist
5153 (cons '(vms . ange-ftp-vms-add-file-entry)
5154 ange-ftp-add-file-entry-alist)))
5157 (defun ange-ftp-add-vms-host (host)
5162 (and name (car (ange-ftp-ftp-name name)))))))
5163 (if (not (ange-ftp-vms-host host))
5164 (setq ange-ftp-vms-host-regexp
5166 (and ange-ftp-vms-host-regexp "\\|")
5167 ange-ftp-vms-host-regexp)
5168 ange-ftp-host-cache nil)))
5171 (defun ange-ftp-vms-file-name-as-directory (name)
5173 (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?\\'" name)
5175 (ange-ftp-real-file-name-as-directory name)))
5177 (or (assq 'vms ange-ftp-file-name-as-directory-alist)
5178 (setq ange-ftp-file-name-as-directory-alist
5179 (cons '(vms . ange-ftp-vms-file-name-as-directory)
5180 ange-ftp-file-name-as-directory-alist)))
5191 ;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
5194 ;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
5197 ;;(or (assq 'vms ange-ftp-dired-re-exe-alist)
5198 ;; (setq ange-ftp-dired-re-exe-alist
5199 ;; (cons (cons 'vms ange-ftp-dired-vms-re-exe)
5200 ;; ange-ftp-dired-re-exe-alist)))
5202 ;;(or (assq 'vms ange-ftp-dired-re-dir-alist)
5203 ;; (setq ange-ftp-dired-re-dir-alist
5204 ;; (cons (cons 'vms ange-ftp-dired-vms-re-dir)
5205 ;; ange-ftp-dired-re-dir-alist)))
5207 ;;(defun ange-ftp-dired-vms-insert-headerline (dir)
5209 ;; ;; to be in ange-ftp format. This version tries to
5211 ;; ;; over ftp, and we wouldn't want to delete anything
5218 ;; (ange-ftp-real-dired-insert-headerline dir))
5220 ;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
5221 ;; (setq ange-ftp-dired-insert-headerline-alist
5222 ;; (cons '(vms . ange-ftp-dired-vms-insert-headerline)
5223 ;; ange-ftp-dired-insert-headerline-alist)))
5225 ;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
5232 ;; (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
5238 ;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
5239 ;; (setq ange-ftp-dired-move-to-filename-alist
5240 ;; (cons '(vms . ange-ftp-dired-vms-move-to-filename)
5241 ;; ange-ftp-dired-move-to-filename-alist)))
5243 ;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
5256 ;; (re-search-forward ange-ftp-vms-filename-regexp eol t))
5268 ;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
5269 ;; (setq ange-ftp-dired-move-to-end-of-filename-alist
5270 ;; (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
5271 ;; ange-ftp-dired-move-to-end-of-filename-alist)))
5273 ;;(defun ange-ftp-dired-vms-between-files ()
5282 ;;(or (assq 'vms ange-ftp-dired-between-files-alist)
5283 ;; (setq ange-ftp-dired-between-files-alist
5284 ;; (cons '(vms . ange-ftp-dired-vms-between-files)
5285 ;; ange-ftp-dired-between-files-alist)))
5292 (defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
5307 (or (assq 'vms ange-ftp-make-compressed-filename-alist)
5308 (setq ange-ftp-make-compressed-filename-alist
5309 (cons '(vms . ange-ftp-vms-make-compressed-filename)
5310 ange-ftp-make-compressed-filename-alist)))
5318 ;;(defun ange-ftp-dired-vms-ls-trim ()
5321 ;; (re-search-forward ange-ftp-vms-filename-regexp))
5328 ;;(or (assq 'vms ange-ftp-dired-ls-trim-alist)
5329 ;; (setq ange-ftp-dired-ls-trim-alist
5330 ;; (cons '(vms . ange-ftp-dired-vms-ls-trim)
5331 ;; ange-ftp-dired-ls-trim-alist)))
5333 (defun ange-ftp-vms-sans-version (name &rest args)
5339 (or (assq 'vms ange-ftp-sans-version-alist)
5340 (setq ange-ftp-sans-version-alist
5341 (cons '(vms . ange-ftp-vms-sans-version)
5342 ange-ftp-sans-version-alist)))
5344 ;;(defvar ange-ftp-file-version-alist)
5348 ;;;;; ange-ftp-dired-vms-flag-backup-files.
5350 ;;(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
5365 ;; (ange-ftp-trample-marker (or marker dired-del-marker))
5366 ;; (ange-ftp-file-version-alist ()))
5372 ;; ;; put on ange-ftp-file-version-alist an element of the form
5374 ;; (dired-map-dired-file-lines 'ange-ftp-dired-vms-collect-file-versions)
5377 ;; (let ((fval ange-ftp-file-version-alist))
5391 ;; 'ange-ftp-dired-vms-trample-file-versions mark)
5394 ;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
5395 ;; (setq ange-ftp-dired-clean-directory-alist
5396 ;; (cons '(vms . ange-ftp-dired-vms-clean-directory)
5397 ;; ange-ftp-dired-clean-directory-alist)))
5399 ;;(defun ange-ftp-dired-vms-collect-file-versions (fn)
5403 ;;(let ((name (nth 2 (ange-ftp-ftp-name fn))))
5406 ;; (fn (ange-ftp-replace-name-component fn name)))
5407 ;; (if (not (assq fn ange-ftp-file-version-alist))
5424 ;; ange-ftp-file-version-alist
5426 ;; ange-ftp-file-version-alist)))))))))
5428 ;;(defun ange-ftp-dired-vms-trample-file-versions (fn)
5434 ;; ange-ftp-file-version-alist)) ; subversion
5439 ;; (insert ange-ftp-trample-marker)))))
5441 ;;(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
5448 ;; (ange-ftp-dired-vms-clean-directory nil marker msg)))
5450 ;;(or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
5451 ;; (setq ange-ftp-dired-flag-backup-files-alist
5452 ;; (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
5453 ;; ange-ftp-dired-flag-backup-files-alist)))
5455 ;;(defun ange-ftp-dired-vms-backup-diff (&optional switches)
5456 ;; (let ((file (dired-get-filename 'no-dir))
5475 ;;(or (assq 'vms ange-ftp-dired-backup-diff-alist)
5476 ;; (setq ange-ftp-dired-backup-diff-alist
5477 ;; (cons '(vms . ange-ftp-dired-vms-backup-diff)
5478 ;; ange-ftp-dired-backup-diff-alist)))
5489 (defun ange-ftp-fix-name-for-mts (name &optional reverse)
5504 (or (assq 'mts ange-ftp-fix-name-func-alist)
5505 (setq ange-ftp-fix-name-func-alist
5506 (cons '(mts . ange-ftp-fix-name-for-mts)
5507 ange-ftp-fix-name-func-alist)))
5511 (defun ange-ftp-fix-dir-name-for-mts (dir-name)
5512 (if (string-equal dir-name "/")
5514 (let ((dir-name (ange-ftp-fix-name-for-mts dir-name)))
5516 ((string-equal dir-name "")
5518 ((string-match ":\\'" dir-name)
5519 (concat dir-name "?"))
5520 (dir-name))))) ; It's just a single file.
5522 (or (assq 'mts ange-ftp-fix-dir-name-func-alist)
5523 (setq ange-ftp-fix-dir-name-func-alist
5524 (cons '(mts . ange-ftp-fix-dir-name-for-mts)
5525 ange-ftp-fix-dir-name-func-alist)))
5527 (or (memq 'mts ange-ftp-dumb-host-types)
5528 (setq ange-ftp-dumb-host-types
5529 (cons 'mts ange-ftp-dumb-host-types)))
5531 (defvar ange-ftp-mts-host-regexp nil)
5534 (defun ange-ftp-mts-host (host)
5535 (and ange-ftp-mts-host-regexp
5537 (string-match ange-ftp-mts-host-regexp host))))
5539 ;; Parse the current buffer which is assumed to be in mts ftp dir format.
5540 (defun ange-ftp-parse-mts-listing ()
5555 (add-to-list 'ange-ftp-parse-list-func-alist
5556 '(mts . ange-ftp-parse-mts-listing))
5558 (defun ange-ftp-add-mts-host (host)
5563 (and name (car (ange-ftp-ftp-name name)))))))
5564 (if (not (ange-ftp-mts-host host))
5565 (setq ange-ftp-mts-host-regexp
5567 (and ange-ftp-mts-host-regexp "\\|")
5568 ange-ftp-mts-host-regexp)
5569 ange-ftp-host-cache nil)))
5574 ;;;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
5575 ;;;; implement ftp in the same way. If not, it might be necessary to make the
5578 ;;(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
5585 ;; ange-ftp-date-regexp eol t)
5599 ;;(or (assq 'mts ange-ftp-dired-move-to-filename-alist)
5600 ;; (setq ange-ftp-dired-move-to-filename-alist
5601 ;; (cons '(mts . ange-ftp-dired-mts-move-to-filename)
5602 ;; ange-ftp-dired-move-to-filename-alist)))
5604 ;;(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
5628 ;;(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
5629 ;; (setq ange-ftp-dired-move-to-end-of-filename-alist
5630 ;; (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
5631 ;; ange-ftp-dired-move-to-end-of-filename-alist)))
5642 ;; the default minidisk. This is fairly likely since CMS ftp servers
5647 (defun ange-ftp-fix-name-for-cms (name &optional reverse)
5652 ;; directory file name. Note that the expand-dir-hashtable
5664 ;; to ange-ftp-send-cmd
5665 (proc (ange-ftp-get-process ange-ftp-this-host
5666 ange-ftp-this-user)))
5668 ;; Must use ange-ftp-raw-send-cmd here to avoid
5670 (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))
5673 (setq proc (ange-ftp-get-process ange-ftp-this-host
5674 ange-ftp-this-user))
5675 (let ((result (ange-ftp-raw-send-cmd proc cmd
5676 ange-ftp-this-msg)))
5680 (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
5687 (or (assq 'cms ange-ftp-fix-name-func-alist)
5688 (setq ange-ftp-fix-name-func-alist
5689 (cons '(cms . ange-ftp-fix-name-for-cms)
5690 ange-ftp-fix-name-func-alist)))
5692 (or (memq 'cms ange-ftp-dumb-host-types)
5693 (setq ange-ftp-dumb-host-types
5694 (cons 'cms ange-ftp-dumb-host-types)))
5697 (defun ange-ftp-fix-dir-name-for-cms (dir-name)
5699 ((string-equal "/" dir-name)
5701 ((string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'" dir-name)
5702 (let* ((minidisk (match-string 1 dir-name))
5703 ;; host and user are bound in the call to ange-ftp-send-cmd
5704 (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
5708 (match-string 2 dir-name)
5711 (if (car (ange-ftp-raw-send-cmd proc cmd))
5714 (setq proc (ange-ftp-get-process ange-ftp-this-host
5715 ange-ftp-this-user))
5716 (let ((result (ange-ftp-raw-send-cmd proc cmd)))
5720 (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
5725 (or (assq 'cms ange-ftp-fix-dir-name-func-alist)
5726 (setq ange-ftp-fix-dir-name-func-alist
5727 (cons '(cms . ange-ftp-fix-dir-name-for-cms)
5728 ange-ftp-fix-dir-name-func-alist)))
5730 (defvar ange-ftp-cms-host-regexp nil
5734 (defun ange-ftp-cms-host (host)
5735 (and ange-ftp-cms-host-regexp
5737 (string-match ange-ftp-cms-host-regexp host))))
5739 (defun ange-ftp-add-cms-host (host)
5744 (and name (car (ange-ftp-ftp-name name)))))))
5745 (if (not (ange-ftp-cms-host host))
5746 (setq ange-ftp-cms-host-regexp
5748 (and ange-ftp-cms-host-regexp "\\|")
5749 ange-ftp-cms-host-regexp)
5750 ange-ftp-host-cache nil)))
5752 (defun ange-ftp-parse-cms-listing ()
5755 ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
5756 ;; because ange-ftp doesn't know that the root hashtable has only part of
5760 ; (let* ((dir-file (directory-file-name file))
5761 ; (root (file-name-directory dir-file))
5762 ; (minidisk (ange-ftp-get-file-part dir-file))
5763 ; (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
5766 ; (setq root-tbl (ange-ftp-make-hashtable))
5769 ; (ange-ftp-set-files root root-tbl)))
5782 (add-to-list 'ange-ftp-parse-list-func-alist
5783 '(cms . ange-ftp-parse-cms-listing))
5787 ;;(defconst ange-ftp-dired-cms-re-exe
5791 ;;(or (assq 'cms ange-ftp-dired-re-exe-alist)
5792 ;; (setq ange-ftp-dired-re-exe-alist
5793 ;; (cons (cons 'cms ange-ftp-dired-cms-re-exe)
5794 ;; ange-ftp-dired-re-exe-alist)))
5797 ;;(defun ange-ftp-dired-cms-insert-headerline (dir)
5802 ;; (ange-ftp-real-dired-insert-headerline dir))
5804 ;;(or (assq 'cms ange-ftp-dired-insert-headerline-alist)
5805 ;; (setq ange-ftp-dired-insert-headerline-alist
5806 ;; (cons '(cms . ange-ftp-dired-cms-insert-headerline)
5807 ;; ange-ftp-dired-insert-headerline-alist)))
5809 ;;(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
5821 ;;(or (assq 'cms ange-ftp-dired-move-to-filename-alist)
5822 ;; (setq ange-ftp-dired-move-to-filename-alist
5823 ;; (cons '(cms . ange-ftp-dired-cms-move-to-filename)
5824 ;; ange-ftp-dired-move-to-filename-alist)))
5826 ;;(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
5853 ;;(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
5854 ;; (setq ange-ftp-dired-move-to-end-of-filename-alist
5855 ;; (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
5856 ;; ange-ftp-dired-move-to-end-of-filename-alist)))
5858 (defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
5863 (or (assq 'cms ange-ftp-make-compressed-filename-alist)
5864 (setq ange-ftp-make-compressed-filename-alist
5865 (cons '(cms . ange-ftp-cms-make-compressed-filename)
5866 ange-ftp-make-compressed-filename-alist)))
5868 ;;(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
5869 ;; (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
5877 ;;(or (assq 'cms ange-ftp-dired-get-filename-alist)
5878 ;; (setq ange-ftp-dired-get-filename-alist
5879 ;; (cons '(cms . ange-ftp-dired-cms-get-filename)
5880 ;; ange-ftp-dired-get-filename-alist)))
5889 (defconst ange-ftp-bs2000-short-filename-regexp
5893 (defconst ange-ftp-bs2000-fix-name-regexp-reverse
5895 "^\\(" ange-ftp-bs2000-filename-pubset-regexp "\\)?"
5896 "\\(" ange-ftp-bs2000-filename-username-regexp "\\)?"
5897 "\\(" ange-ftp-bs2000-short-filename-regexp "\\)?")
5898 "Regular expression used in ange-ftp-fix-name-for-bs2000.")
5900 (defconst ange-ftp-bs2000-fix-name-regexp
5902 "/?\\(" ange-ftp-bs2000-filename-pubset-regexp "/\\)?"
5904 "\\(" ange-ftp-bs2000-short-filename-regexp "\\)?")
5905 "Regular expression used in ange-ftp-fix-name-for-bs2000.")
5907 (defcustom ange-ftp-bs2000-special-prefix
5910 :group 'ange-ftp
5915 (defun ange-ftp-fix-name-for-bs2000 (name &optional reverse)
5919 ange-ftp-bs2000-fix-name-regexp-reverse
5942 ange-ftp-bs2000-fix-name-regexp
5957 (setq filename (concat ange-ftp-bs2000-special-prefix
5969 (or (assq 'bs2000 ange-ftp-fix-name-func-alist)
5970 (setq ange-ftp-fix-name-func-alist
5971 (cons '(bs2000 . ange-ftp-fix-name-for-bs2000)
5972 ange-ftp-fix-name-func-alist)))
5976 (defun ange-ftp-fix-dir-name-for-bs2000 (dir-name)
5977 (if (string-equal dir-name "/")
5979 (ange-ftp-fix-name-for-bs2000 dir-name)))
5981 (or (assq 'bs2000 ange-ftp-fix-dir-name-func-alist)
5982 (setq ange-ftp-fix-dir-name-func-alist
5983 (cons '(bs2000 . ange-ftp-fix-dir-name-for-bs2000)
5984 ange-ftp-fix-dir-name-func-alist)))
5986 (or (memq 'bs2000 ange-ftp-dumb-host-types)
5987 (setq ange-ftp-dumb-host-types
5988 (cons 'bs2000 ange-ftp-dumb-host-types)))
5990 (defvar ange-ftp-bs2000-host-regexp nil)
5991 (defvar ange-ftp-bs2000-posix-host-regexp nil)
5994 (defun ange-ftp-bs2000-host (host)
5995 (and ange-ftp-bs2000-host-regexp
5997 (string-match ange-ftp-bs2000-host-regexp host))))
5999 (defun ange-ftp-bs2000-posix-host (host)
6000 (and ange-ftp-bs2000-posix-host-regexp
6002 (string-match ange-ftp-bs2000-posix-host-regexp host))))
6004 (defun ange-ftp-add-bs2000-host (host)
6009 (and name (car (ange-ftp-ftp-name name)))))))
6010 (if (not (ange-ftp-bs2000-host host))
6011 (setq ange-ftp-bs2000-host-regexp
6013 (and ange-ftp-bs2000-host-regexp "\\|")
6014 ange-ftp-bs2000-host-regexp)
6015 ange-ftp-host-cache nil)))
6017 (defun ange-ftp-add-bs2000-posix-host (host)
6022 (and name (car (ange-ftp-ftp-name name)))))))
6023 (if (not (ange-ftp-bs2000-posix-host host))
6024 (setq ange-ftp-bs2000-posix-host-regexp
6026 (and ange-ftp-bs2000-posix-host-regexp "\\|")
6027 ange-ftp-bs2000-posix-host-regexp)
6028 ange-ftp-host-cache nil))
6030 (add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix)
6033 (defconst ange-ftp-bs2000-filename-regexp
6035 "\\(" ange-ftp-bs2000-filename-prefix-regexp "\\)?"
6036 "\\(" ange-ftp-bs2000-short-filename-regexp "\\)")
6039 (defcustom ange-ftp-bs2000-additional-pubsets
6042 :group 'ange-ftp
6046 ;; of ftp listings from BS2000 hosts is a bit erratic. What saves us is that
6050 (defun ange-ftp-parse-bs2000-filename ()
6051 (if (re-search-forward ange-ftp-bs2000-filename-regexp nil t)
6054 ;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir
6056 (defun ange-ftp-parse-bs2000-listing ()
6062 (if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t)
6067 (while (setq file (ange-ftp-parse-bs2000-filename))
6073 (if (not (member pubset ange-ftp-bs2000-additional-pubsets))
6075 ange-ftp-bs2000-additional-pubsets))
6078 (add-to-list 'ange-ftp-parse-list-func-alist
6079 '(bs2000 . ange-ftp-parse-bs2000-listing))
6081 (defun ange-ftp-bs2000-cd-to-posix ()
6083 `ange-ftp-bs2000-posix-host-regexp'. All BS2000 hosts with POSIX subsystem
6084 MUST BE EXPLICITLY SET with `ange-ftp-add-bs2000-posix-host' for they cannot
6086 (if (and ange-ftp-this-host (ange-ftp-bs2000-posix-host ange-ftp-this-host))
6089 ; (ange-ftp-raw-send-cmd proc "cd %POSIX")
6090 (ange-ftp-cd ange-ftp-this-host ange-ftp-this-user "%POSIX")
6091 ;; put new home directory in the expand-dir hashtable.
6092 ;; `ange-ftp-this-host' and `ange-ftp-this-user' are bound in
6093 ;; ange-ftp-get-process.
6094 (puthash (concat ange-ftp-this-host "/" ange-ftp-this-user "/~")
6095 (car (ange-ftp-get-pwd ange-ftp-this-host ange-ftp-this-user))
6096 ange-ftp-expand-dir-hashtable))))
6099 ;; ange-ftp-bs2000-delete-file-entry
6100 ;; ange-ftp-bs2000-add-file-entry
6101 ;; ange-ftp-bs2000-file-name-as-directory
6102 ;; ange-ftp-bs2000-make-compressed-filename
6103 ;; ange-ftp-bs2000-file-name-sans-versions
6110 (provide 'ange-ftp)
6113 ;;; ange-ftp.el ends here