428 |
;; ange-ftp-bs2000-special-prefix because names starting with # or @ |
;; ange-ftp-bs2000-special-prefix because names starting with # or @ |
429 |
;; are reserved for temporary files. |
;; are reserved for temporary files. |
430 |
;; This is especially important for auto-save files. |
;; This is especially important for auto-save files. |
431 |
;; Valid file generations are ending with ([+|-|*]0-9...) . |
;; Valid file generations are ending with ([+|-|*]0-9...) . |
432 |
;; File generations are not supported yet! |
;; File generations are not supported yet! |
433 |
;; A filename must at least contain one character (A-Z) and cannot be longer |
;; A filename must at least contain one character (A-Z) and cannot be longer |
434 |
;; than 41 characters. |
;; than 41 characters. |
543 |
;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to |
;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to |
544 |
;; the mailing list. |
;; the mailing list. |
545 |
|
|
|
;; [The following information about lists may be obsolete.] |
|
|
|
|
546 |
;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the |
;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the |
547 |
;; list, please mail one of the following addresses: |
;; list, please mail one of the following addresses: |
548 |
;; |
;; |
549 |
;; ange-ftp-lovers-request@anorman.hpl.hp.com |
;; ange-ftp-lovers-request@hplb.hpl.hp.com |
|
;; or |
|
|
;; ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com |
|
550 |
;; |
;; |
551 |
;; Please don't forget the -request part. |
;; Please don't forget the -request part. |
552 |
;; |
;; |
553 |
;; For mail to be posted directly to ange-ftp-lovers, send to one of the |
;; For mail to be posted directly to ange-ftp-lovers, send to one of the |
554 |
;; following addresses: |
;; following addresses: |
555 |
;; |
;; |
556 |
;; ange-ftp-lovers@anorman.hpl.hp.com |
;; ange-ftp-lovers@hplb.hpl.hp.com |
|
;; or |
|
|
;; ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com |
|
557 |
;; |
;; |
558 |
;; Alternatively, there is a mailing list that only gets announcements of new |
;; Alternatively, there is a mailing list that only gets announcements of new |
559 |
;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be |
;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be |
560 |
;; subscribed to by e-mailing to the -request address as above. Please make |
;; subscribed to by e-mailing to the -request address as above. Please make |
561 |
;; it clear in the request which mailing list you wish to join. |
;; it clear in the request which mailing list you wish to join. |
|
|
|
|
;; The archives for ange-ftp-lovers can be found via anonymous ftp under: |
|
|
;; |
|
|
;; ftp.reed.edu:pub/mailing-lists/ange-ftp/ |
|
562 |
|
|
563 |
;; ----------------------------------------------------------- |
;; ----------------------------------------------------------- |
564 |
;; Technical information on this package: |
;; Technical information on this package: |
728 |
"^Data connection \\|" |
"^Data connection \\|" |
729 |
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|" |
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|" |
730 |
"^500 .*AUTH \\(KERBEROS\\|GSSAPI\\)\\|^KERBEROS\\|" |
"^500 .*AUTH \\(KERBEROS\\|GSSAPI\\)\\|^KERBEROS\\|" |
731 |
|
"^530 Please login with USER and PASS\\|" ; non kerberised vsFTPd |
732 |
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT") |
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT") |
733 |
"*Regular expression matching ftp messages that can be ignored." |
"*Regular expression matching ftp messages that can be ignored." |
734 |
:group 'ange-ftp |
:group 'ange-ftp |
907 |
arrange to strip out trailing ^M characters.") |
arrange to strip out trailing ^M characters.") |
908 |
|
|
909 |
(defcustom ange-ftp-smart-gateway nil |
(defcustom ange-ftp-smart-gateway nil |
910 |
"*Non-nil means the ftp gateway and/or the gateway ftp program is smart. |
"*Non-nil says the ftp gateway (proxy) or gateway ftp program is smart. |
911 |
|
|
912 |
Don't bother telnetting, etc., already connected to desired host transparently, |
Don't bother telnetting, etc., already connected to desired host transparently, |
913 |
or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil." |
or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil. |
914 |
|
See also `ange-ftp-smart-gateway-port'." |
915 |
:group 'ange-ftp |
:group 'ange-ftp |
916 |
:type 'boolean) |
:type 'boolean) |
917 |
|
|
1012 |
|
|
1013 |
(require 'backquote) |
(require 'backquote) |
1014 |
|
|
|
(defun ange-ftp-make-hashtable (&optional size) |
|
|
"Make an obarray suitable for use as a hashtable. |
|
|
SIZE, if supplied, should be a prime number." |
|
|
(make-vector (or size 31) 0)) |
|
|
|
|
|
(defun ange-ftp-map-hashtable (fun tbl) |
|
|
"Call FUNCTION on each key and value in HASHTABLE." |
|
|
(mapatoms |
|
|
(function |
|
|
(lambda (sym) |
|
|
(funcall fun (get sym 'key) (get sym 'val)))) |
|
|
tbl)) |
|
|
|
|
|
(defmacro ange-ftp-make-hash-key (key) |
|
|
"Convert KEY into a suitable key for a hashtable." |
|
|
`(if (stringp ,key) |
|
|
,key |
|
|
(prin1-to-string ,key))) |
|
|
|
|
|
(defun ange-ftp-get-hash-entry (key tbl) |
|
|
"Return the value associated with KEY in HASHTABLE." |
|
|
(let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl))) |
|
|
(and sym (get sym 'val)))) |
|
|
|
|
|
(defun ange-ftp-put-hash-entry (key val tbl) |
|
|
"Record an association between KEY and VALUE in HASHTABLE." |
|
|
(let ((sym (intern (ange-ftp-make-hash-key key) tbl))) |
|
|
(put sym 'val val) |
|
|
(put sym 'key key))) |
|
|
|
|
|
(defun ange-ftp-del-hash-entry (key tbl) |
|
|
"Copy all symbols except KEY in HASHTABLE and return modified hashtable." |
|
|
(let* ((len (length tbl)) |
|
|
(new-tbl (ange-ftp-make-hashtable len)) |
|
|
(i (1- len))) |
|
|
(ange-ftp-map-hashtable |
|
|
(function |
|
|
(lambda (k v) |
|
|
(or (equal k key) |
|
|
(ange-ftp-put-hash-entry k v new-tbl)))) |
|
|
tbl) |
|
|
(while (>= i 0) |
|
|
(aset tbl i (aref new-tbl i)) |
|
|
(setq i (1- i))) |
|
|
tbl)) |
|
|
|
|
1015 |
(defun ange-ftp-hash-entry-exists-p (key tbl) |
(defun ange-ftp-hash-entry-exists-p (key tbl) |
1016 |
"Return whether there is an association for KEY in TABLE." |
"Return whether there is an association for KEY in TABLE." |
1017 |
(intern-soft (ange-ftp-make-hash-key key) tbl)) |
(not (eq (gethash key tbl 'unknown) 'unknown))) |
1018 |
|
|
1019 |
(defun ange-ftp-hash-table-keys (tbl) |
(defun ange-ftp-hash-table-keys (tbl) |
1020 |
"Return a sorted list of all the active keys in TABLE, as strings." |
"Return a sorted list of all the active keys in TABLE, as strings." |
1021 |
(sort (all-completions "" tbl) |
;; (let ((keys nil)) |
1022 |
(function string-lessp))) |
;; (maphash (lambda (k v) (push k keys)) tbl) |
1023 |
|
;; (sort keys 'string-lessp)) |
1024 |
|
(sort (all-completions "" tbl) 'string-lessp)) |
1025 |
|
|
1026 |
;;;; ------------------------------------------------------------ |
;;;; ------------------------------------------------------------ |
1027 |
;;;; Internal variables. |
;;;; Internal variables. |
1033 |
(defvar ange-ftp-netrc-modtime nil |
(defvar ange-ftp-netrc-modtime nil |
1034 |
"Last modified time of the netrc file from file-attributes.") |
"Last modified time of the netrc file from file-attributes.") |
1035 |
|
|
1036 |
(defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable) |
(defvar ange-ftp-user-hashtable (make-hash-table :test 'equal) |
1037 |
"Hash table holding associations between HOST, USER pairs.") |
"Hash table holding associations between HOST, USER pairs.") |
1038 |
|
|
1039 |
(defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable) |
(defvar ange-ftp-passwd-hashtable (make-hash-table :test 'equal) |
1040 |
"Mapping between a HOST, USER pair and a PASSWORD for them. |
"Mapping between a HOST, USER pair and a PASSWORD for them. |
1041 |
All HOST values should be in lower case.") |
All HOST values should be in lower case.") |
1042 |
|
|
1043 |
(defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable) |
(defvar ange-ftp-account-hashtable (make-hash-table :test 'equal) |
1044 |
"Mapping between a HOST, USER pair and a ACCOUNT password for them.") |
"Mapping between a HOST, USER pair and a ACCOUNT password for them.") |
1045 |
|
|
1046 |
(defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97) |
(defvar ange-ftp-files-hashtable (make-hash-table :test 'equal :size 97) |
1047 |
"Hash table for storing directories and their respective files.") |
"Hash table for storing directories and their respective files.") |
1048 |
|
|
1049 |
(defvar ange-ftp-inodes-hashtable (ange-ftp-make-hashtable 97) |
(defvar ange-ftp-inodes-hashtable (make-hash-table :test 'equal :size 97) |
1050 |
"Hash table for storing file names and their \"inode numbers\".") |
"Hash table for storing file names and their \"inode numbers\".") |
1051 |
|
|
1052 |
(defvar ange-ftp-next-inode-number 1 |
(defvar ange-ftp-next-inode-number 1 |
1061 |
(defvar ange-ftp-ls-cache-res nil |
(defvar ange-ftp-ls-cache-res nil |
1062 |
"Last result returned from ange-ftp-ls.") |
"Last result returned from ange-ftp-ls.") |
1063 |
|
|
1064 |
(defconst ange-ftp-expand-dir-hashtable (ange-ftp-make-hashtable)) |
(defconst ange-ftp-expand-dir-hashtable (make-hash-table :test 'equal)) |
1065 |
|
|
1066 |
(defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):") |
(defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):") |
1067 |
|
|
1099 |
(defun ange-ftp-message (fmt &rest args) |
(defun ange-ftp-message (fmt &rest args) |
1100 |
"Display message in echo area, but indicate if truncated. |
"Display message in echo area, but indicate if truncated. |
1101 |
Args are as in `message': a format string, plus arguments to be formatted." |
Args are as in `message': a format string, plus arguments to be formatted." |
1102 |
(let ((msg (apply (function format) fmt args)) |
(let ((msg (apply 'format fmt args)) |
1103 |
(max (window-width (minibuffer-window)))) |
(max (window-width (minibuffer-window)))) |
1104 |
(if noninteractive |
(if noninteractive |
1105 |
msg |
msg |
1131 |
(defun ange-ftp-set-user (host user) |
(defun ange-ftp-set-user (host user) |
1132 |
"For a given HOST, set or change the default USER." |
"For a given HOST, set or change the default USER." |
1133 |
(interactive "sHost: \nsUser: ") |
(interactive "sHost: \nsUser: ") |
1134 |
(ange-ftp-put-hash-entry host user ange-ftp-user-hashtable)) |
(puthash host user ange-ftp-user-hashtable)) |
1135 |
|
|
1136 |
(defun ange-ftp-get-user (host) |
(defun ange-ftp-get-user (host) |
1137 |
"Given a HOST, return the default USER." |
"Given a HOST, return the default USER." |
1138 |
(ange-ftp-parse-netrc) |
(ange-ftp-parse-netrc) |
1139 |
(let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable))) |
(let ((user (gethash host ange-ftp-user-hashtable))) |
1140 |
(or user |
(or user |
1141 |
(prog1 |
(prog1 |
1142 |
(setq user |
(setq user |
1162 |
`(concat (downcase ,host) "/" ,user)) |
`(concat (downcase ,host) "/" ,user)) |
1163 |
|
|
1164 |
(defmacro ange-ftp-lookup-passwd (host user) |
(defmacro ange-ftp-lookup-passwd (host user) |
1165 |
`(ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key ,host ,user) |
`(gethash (ange-ftp-generate-passwd-key ,host ,user) |
1166 |
ange-ftp-passwd-hashtable)) |
ange-ftp-passwd-hashtable)) |
1167 |
|
|
1168 |
(defun ange-ftp-set-passwd (host user passwd) |
(defun ange-ftp-set-passwd (host user passwd) |
1169 |
"For a given HOST and USER, set or change the associated PASSWORD." |
"For a given HOST and USER, set or change the associated PASSWORD." |
1170 |
(interactive (list (read-string "Host: ") |
(interactive (list (read-string "Host: ") |
1171 |
(read-string "User: ") |
(read-string "User: ") |
1172 |
(read-passwd "Password: "))) |
(read-passwd "Password: "))) |
1173 |
(ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user) |
(puthash (ange-ftp-generate-passwd-key host user) |
1174 |
passwd |
passwd ange-ftp-passwd-hashtable)) |
|
ange-ftp-passwd-hashtable)) |
|
1175 |
|
|
1176 |
(defun ange-ftp-get-host-with-passwd (user) |
(defun ange-ftp-get-host-with-passwd (user) |
1177 |
"Given a USER, return a host we know the password for." |
"Given a USER, return a host we know the password for." |
1178 |
(ange-ftp-parse-netrc) |
(ange-ftp-parse-netrc) |
1179 |
(catch 'found-one |
(catch 'found-one |
1180 |
(ange-ftp-map-hashtable |
(maphash |
1181 |
(function (lambda (host val) |
(lambda (host val) |
1182 |
(if (ange-ftp-lookup-passwd host user) |
(if (ange-ftp-lookup-passwd host user) (throw 'found-one host))) |
|
(throw 'found-one host)))) |
|
1183 |
ange-ftp-user-hashtable) |
ange-ftp-user-hashtable) |
1184 |
(save-match-data |
(save-match-data |
1185 |
(ange-ftp-map-hashtable |
(maphash |
1186 |
(function |
(lambda (key value) |
1187 |
(lambda (key value) |
(if (string-match "^[^/]*\\(/\\).*$" key) |
1188 |
(if (string-match "^[^/]*\\(/\\).*$" key) |
(let ((host (substring key 0 (match-beginning 1)))) |
1189 |
(let ((host (substring key 0 (match-beginning 1)))) |
(if (and (string-equal user (substring key (match-end 1))) |
1190 |
(if (and (string-equal user (substring key (match-end 1))) |
value) |
1191 |
value) |
(throw 'found-one host))))) |
|
(throw 'found-one host)))))) |
|
1192 |
ange-ftp-passwd-hashtable)) |
ange-ftp-passwd-hashtable)) |
1193 |
nil)) |
nil)) |
1194 |
|
|
1255 |
(interactive (list (read-string "Host: ") |
(interactive (list (read-string "Host: ") |
1256 |
(read-string "User: ") |
(read-string "User: ") |
1257 |
(read-passwd "Account password: "))) |
(read-passwd "Account password: "))) |
1258 |
(ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user) |
(puthash (ange-ftp-generate-passwd-key host user) |
1259 |
account |
account ange-ftp-account-hashtable)) |
|
ange-ftp-account-hashtable)) |
|
1260 |
|
|
1261 |
(defun ange-ftp-get-account (host user) |
(defun ange-ftp-get-account (host user) |
1262 |
"Given a HOST and USER, return the FTP account." |
"Given a HOST and USER, return the FTP account." |
1263 |
(ange-ftp-parse-netrc) |
(ange-ftp-parse-netrc) |
1264 |
(or (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key host user) |
(or (gethash (ange-ftp-generate-passwd-key host user) |
1265 |
ange-ftp-account-hashtable) |
ange-ftp-account-hashtable) |
1266 |
(and (stringp ange-ftp-default-user) |
(and (stringp ange-ftp-default-user) |
1267 |
(string-equal user ange-ftp-default-user) |
(string-equal user ange-ftp-default-user) |
1268 |
ange-ftp-default-account) |
ange-ftp-default-account) |
1378 |
(setq buffer-file-name file) |
(setq buffer-file-name file) |
1379 |
(setq default-directory (file-name-directory file)) |
(setq default-directory (file-name-directory file)) |
1380 |
(normal-mode t) |
(normal-mode t) |
1381 |
(mapcar 'funcall find-file-hooks) |
(run-hooks 'find-file-hook) |
1382 |
(setq buffer-file-name nil) |
(setq buffer-file-name nil) |
1383 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1384 |
(skip-chars-forward " \t\r\n") |
(skip-chars-forward " \t\r\n") |
1397 |
(ange-ftp-parse-netrc) |
(ange-ftp-parse-netrc) |
1398 |
(save-match-data |
(save-match-data |
1399 |
(let (res) |
(let (res) |
1400 |
(ange-ftp-map-hashtable |
(maphash |
1401 |
(function |
(lambda (key value) |
1402 |
(lambda (key value) |
(if (string-match "^[^/]*\\(/\\).*$" key) |
1403 |
(if (string-match "^[^/]*\\(/\\).*$" key) |
(let ((host (substring key 0 (match-beginning 1))) |
1404 |
(let ((host (substring key 0 (match-beginning 1))) |
(user (substring key (match-end 1)))) |
1405 |
(user (substring key (match-end 1)))) |
(push (concat user "@" host ":") res)))) |
|
(push (concat user "@" host ":") res))))) |
|
1406 |
ange-ftp-passwd-hashtable) |
ange-ftp-passwd-hashtable) |
1407 |
(ange-ftp-map-hashtable |
(maphash |
1408 |
(function (lambda (host user) |
(lambda (host user) (push (concat host ":") res)) |
|
(push (concat host ":") res))) |
|
1409 |
ange-ftp-user-hashtable) |
ange-ftp-user-hashtable) |
1410 |
(or res (list nil))))) |
(or res (list nil))))) |
1411 |
|
|
1416 |
(defmacro ange-ftp-ftp-name-component (n ns name) |
(defmacro ange-ftp-ftp-name-component (n ns name) |
1417 |
"Extract the Nth ftp file name component from NS." |
"Extract the Nth ftp file name component from NS." |
1418 |
`(let ((elt (nth ,n ,ns))) |
`(let ((elt (nth ,n ,ns))) |
1419 |
(if (match-beginning elt) |
(match-string elt ,name))) |
|
(substring ,name (match-beginning elt) (match-end elt))))) |
|
1420 |
|
|
1421 |
(defvar ange-ftp-ftp-name-arg "") |
(defvar ange-ftp-ftp-name-arg "") |
1422 |
(defvar ange-ftp-ftp-name-res nil) |
(defvar ange-ftp-ftp-name-res nil) |
1503 |
|
|
1504 |
(defun ange-ftp-quote-string (string) |
(defun ange-ftp-quote-string (string) |
1505 |
"Quote any characters in STRING that may confuse the ftp process." |
"Quote any characters in STRING that may confuse the ftp process." |
1506 |
(apply (function concat) |
(apply 'concat |
1507 |
(mapcar (function |
(mapcar (lambda (char) |
1508 |
;; This is said to be wrong; ftp is said to |
;; This is said to be wrong; ftp is said to |
1509 |
;; need quoting only for ", and that by doubling it. |
;; need quoting only for ", and that by doubling it. |
1510 |
;; But experiment says this kind of quoting is correct |
;; But experiment says this kind of quoting is correct |
1511 |
;; when talking to ftp on GNU/Linux systems. |
;; when talking to ftp on GNU/Linux systems. |
1512 |
(lambda (char) |
(if (or (<= char ? ) |
1513 |
(if (or (<= char ? ) |
(> char ?\~) |
1514 |
(> char ?\~) |
(= char ?\") |
1515 |
(= char ?\") |
(= char ?\\)) |
1516 |
(= char ?\\)) |
(vector ?\\ char) |
1517 |
(vector ?\\ char) |
(vector char))) |
|
(vector char)))) |
|
1518 |
string))) |
string))) |
1519 |
|
|
1520 |
(defun ange-ftp-barf-if-not-directory (directory) |
(defun ange-ftp-barf-if-not-directory (directory) |
1536 |
good, skip, fatal, or unknown." |
good, skip, fatal, or unknown." |
1537 |
(cond ((string-match ange-ftp-xfer-size-msgs line) |
(cond ((string-match ange-ftp-xfer-size-msgs line) |
1538 |
(setq ange-ftp-xfer-size |
(setq ange-ftp-xfer-size |
1539 |
(/ (string-to-number (substring line |
(/ (string-to-number (match-string 1 line)) |
|
(match-beginning 1) |
|
|
(match-end 1))) |
|
1540 |
1024))) |
1024))) |
1541 |
((string-match ange-ftp-skip-msgs line) |
((string-match ange-ftp-skip-msgs line) |
1542 |
t) |
t) |
1591 |
(let ((kbytes (ash (* ange-ftp-hash-mark-unit |
(let ((kbytes (ash (* ange-ftp-hash-mark-unit |
1592 |
ange-ftp-hash-mark-count) |
ange-ftp-hash-mark-count) |
1593 |
-6))) |
-6))) |
1594 |
(if (zerop ange-ftp-xfer-size) |
(if (zerop ange-ftp-xfer-size) |
1595 |
(ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes) |
(ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes) |
1596 |
(let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size))) |
(let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size))) |
1597 |
;; cut out the redisplay of identical %-age messages. |
;; cut out the redisplay of identical %-age messages. |
1598 |
(if (not (eq percent ange-ftp-last-percent)) |
(unless (eq percent ange-ftp-last-percent) |
1599 |
(progn |
(setq ange-ftp-last-percent percent) |
1600 |
(setq ange-ftp-last-percent percent) |
(ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent)))))) |
|
(ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))) |
|
1601 |
str) |
str) |
1602 |
|
|
1603 |
;; Call the function specified by CONT. CONT can be either a function |
;; Call the function specified by CONT. CONT can be either a function |
1687 |
"When ftp process changes state, nuke all file-entries in cache." |
"When ftp process changes state, nuke all file-entries in cache." |
1688 |
(let ((name (process-name proc))) |
(let ((name (process-name proc))) |
1689 |
(if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name) |
(if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name) |
1690 |
(let ((user (substring name (match-beginning 1) (match-end 1))) |
(let ((user (match-string 1 name)) |
1691 |
(host (substring name (match-beginning 2) (match-end 2)))) |
(host (match-string 2 name))) |
1692 |
(ange-ftp-wipe-file-entries host user)))) |
(ange-ftp-wipe-file-entries host user)))) |
1693 |
(setq ange-ftp-ls-cache-file nil)) |
(setq ange-ftp-ls-cache-file nil)) |
1694 |
|
|
1718 |
(defun ange-ftp-make-tmp-name (host) |
(defun ange-ftp-make-tmp-name (host) |
1719 |
"This routine will return the name of a new file." |
"This routine will return the name of a new file." |
1720 |
(make-temp-file (if (ange-ftp-use-gateway-p host) |
(make-temp-file (if (ange-ftp-use-gateway-p host) |
1721 |
ange-ftp-gateway-tmp-name-template |
ange-ftp-gateway-tmp-name-template |
1722 |
ange-ftp-tmp-name-template))) |
ange-ftp-tmp-name-template))) |
1723 |
|
|
1724 |
(defalias 'ange-ftp-del-tmp-name 'delete-file) |
(defalias 'ange-ftp-del-tmp-name 'delete-file) |
1725 |
|
|
1769 |
(start-process name name |
(start-process name name |
1770 |
ange-ftp-gateway-program |
ange-ftp-gateway-program |
1771 |
ange-ftp-gateway-host))) |
ange-ftp-gateway-host))) |
1772 |
(ftp (mapconcat (function identity) args " "))) |
(ftp (mapconcat 'identity args " "))) |
1773 |
(process-kill-without-query proc) |
(process-kill-without-query proc) |
1774 |
(set-process-sentinel proc (function ange-ftp-gwp-sentinel)) |
(set-process-sentinel proc 'ange-ftp-gwp-sentinel) |
1775 |
(set-process-filter proc (function ange-ftp-gwp-filter)) |
(set-process-filter proc 'ange-ftp-gwp-filter) |
1776 |
(save-excursion |
(save-excursion |
1777 |
(set-buffer (process-buffer proc)) |
(set-buffer (process-buffer proc)) |
1778 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1886 |
(accept-process-output proc)) |
(accept-process-output proc)) |
1887 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1888 |
(if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) |
(if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) |
1889 |
(setq res (buffer-substring (match-beginning 1) |
(setq res (match-string 1))) |
|
(match-end 1)))) |
|
1890 |
(kill-buffer (current-buffer))) |
(kill-buffer (current-buffer))) |
1891 |
res) |
res) |
1892 |
host)) |
host)) |
1937 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1938 |
(set-marker (process-mark proc) (point))) |
(set-marker (process-mark proc) (point))) |
1939 |
(process-kill-without-query proc) |
(process-kill-without-query proc) |
1940 |
(set-process-sentinel proc (function ange-ftp-process-sentinel)) |
(set-process-sentinel proc 'ange-ftp-process-sentinel) |
1941 |
(set-process-filter proc (function ange-ftp-process-filter)) |
(set-process-filter proc 'ange-ftp-process-filter) |
1942 |
;; On Windows, the standard ftp client buffers its output (because |
;; On Windows, the standard ftp client buffers its output (because |
1943 |
;; stdout is a pipe handle) so the startup message may never appear: |
;; stdout is a pipe handle) so the startup message may never appear: |
1944 |
;; `accept-process-output' at this point would hang indefinitely. |
;; `accept-process-output' at this point would hang indefinitely. |
2087 |
ange-ftp-skip-msgs skip))) |
ange-ftp-skip-msgs skip))) |
2088 |
(or (car result) |
(or (car result) |
2089 |
(progn |
(progn |
2090 |
(ange-ftp-set-passwd host user nil) ;reset password. |
(ange-ftp-set-passwd host user nil) ;reset password. |
2091 |
(ange-ftp-set-account host user nil) ;reset account. |
(ange-ftp-set-account host user nil) ;reset account. |
2092 |
(ange-ftp-error host user |
(ange-ftp-error host user |
2093 |
(concat "USER request failed: " |
(concat "USER request failed: " |
2107 |
(line (cdr status))) |
(line (cdr status))) |
2108 |
(save-match-data |
(save-match-data |
2109 |
(if (string-match ange-ftp-hash-mark-msgs line) |
(if (string-match ange-ftp-hash-mark-msgs line) |
2110 |
(let ((size (string-to-int |
(let ((size (string-to-int (match-string 1 line)))) |
|
(substring line |
|
|
(match-beginning 1) |
|
|
(match-end 1))))) |
|
2111 |
(setq ange-ftp-ascii-hash-mark-size size |
(setq ange-ftp-ascii-hash-mark-size size |
2112 |
ange-ftp-hash-mark-unit (ash size -4)) |
ange-ftp-hash-mark-unit (ash size -4)) |
2113 |
|
|
2155 |
|
|
2156 |
;; Run any user-specified hooks. Note that proc, host and user are |
;; Run any user-specified hooks. Note that proc, host and user are |
2157 |
;; dynamically bound at this point. |
;; dynamically bound at this point. |
2158 |
(run-hooks 'ange-ftp-process-startup-hook)) |
(let ((ange-ftp-this-user user) |
2159 |
|
(ange-ftp-this-host host)) |
2160 |
|
(run-hooks 'ange-ftp-process-startup-hook))) |
2161 |
proc))) |
proc))) |
2162 |
|
|
2163 |
(defun ange-ftp-passive-mode (proc on-or-off) |
(defun ange-ftp-passive-mode (proc on-or-off) |
2451 |
ange-ftp-fix-name-func-alist))) |
ange-ftp-fix-name-func-alist))) |
2452 |
(if fix-name-func |
(if fix-name-func |
2453 |
(setq dir (funcall fix-name-func dir 'reverse)))) |
(setq dir (funcall fix-name-func dir 'reverse)))) |
2454 |
(ange-ftp-put-hash-entry key dir |
(puthash key dir ange-ftp-expand-dir-hashtable)))) |
|
ange-ftp-expand-dir-hashtable)))) |
|
2455 |
|
|
2456 |
;; In the special case of CMS make sure that know the |
;; In the special case of CMS make sure that know the |
2457 |
;; expansion of the home minidisk now, because we will |
;; expansion of the home minidisk now, because we will |
2461 |
key ange-ftp-expand-dir-hashtable))) |
key ange-ftp-expand-dir-hashtable))) |
2462 |
(let ((dir (car (ange-ftp-get-pwd host user)))) |
(let ((dir (car (ange-ftp-get-pwd host user)))) |
2463 |
(if dir |
(if dir |
2464 |
(ange-ftp-put-hash-entry key (concat "/" dir) |
(puthash key (concat "/" dir) ange-ftp-expand-dir-hashtable) |
|
ange-ftp-expand-dir-hashtable) |
|
2465 |
(message "Warning! Unable to get home directory") |
(message "Warning! Unable to get home directory") |
2466 |
(sit-for 1)))))) |
(sit-for 1)))))) |
2467 |
|
|
2527 |
FILE is the full name of the remote file, LSARGS is any args to pass to the |
FILE is the full name of the remote file, LSARGS is any args to pass to the |
2528 |
`ls' command, and PARSE specifies that the output should be parsed and stored |
`ls' command, and PARSE specifies that the output should be parsed and stored |
2529 |
away in the internal cache." |
away in the internal cache." |
2530 |
|
(when (string-match "^--dired\\s-+" lsargs) |
2531 |
|
(setq lsargs (replace-match "" nil t lsargs))) |
2532 |
;; If parse is t, we assume that file is a directory. i.e. we only parse |
;; If parse is t, we assume that file is a directory. i.e. we only parse |
2533 |
;; full directory listings. |
;; full directory listings. |
2534 |
(let* ((ange-ftp-this-file (ange-ftp-expand-file-name file)) |
(let* ((ange-ftp-this-file (ange-ftp-expand-file-name file)) |
2546 |
(if (string-equal name "") |
(if (string-equal name "") |
2547 |
(setq name |
(setq name |
2548 |
(ange-ftp-real-file-name-as-directory |
(ange-ftp-real-file-name-as-directory |
2549 |
(ange-ftp-expand-dir host user "~")))) |
(ange-ftp-expand-dir host user "~")))) |
2550 |
(if (and ange-ftp-ls-cache-file |
(if (and ange-ftp-ls-cache-file |
2551 |
(string-equal key ange-ftp-ls-cache-file) |
(string-equal key ange-ftp-ls-cache-file) |
2552 |
;; Don't care about lsargs for dumb hosts. |
;; Don't care about lsargs for dumb hosts. |
2695 |
;; unquoting names obtained with the SysV b switch and the GNU Q |
;; unquoting names obtained with the SysV b switch and the GNU Q |
2696 |
;; switch. See Sebastian's dired-get-filename. |
;; switch. See Sebastian's dired-get-filename. |
2697 |
|
|
2698 |
(defmacro ange-ftp-ls-parser () |
(defun ange-ftp-ls-parser (switches) |
|
;; Note that switches is dynamically bound. |
|
2699 |
;; Meant to be called by ange-ftp-parse-dired-listing |
;; Meant to be called by ange-ftp-parse-dired-listing |
2700 |
`(let ((tbl (ange-ftp-make-hashtable)) |
(let ((tbl (make-hash-table :test 'equal)) |
2701 |
(used-F (and (stringp switches) |
(used-F (and (stringp switches) |
2702 |
(string-match "F" switches))) |
(string-match "F" switches))) |
2703 |
file-type symlink directory file) |
file-type symlink directory file) |
2704 |
(while (setq file (ange-ftp-parse-filename)) |
(while (setq file (ange-ftp-parse-filename)) |
2705 |
(beginning-of-line) |
(beginning-of-line) |
2706 |
(skip-chars-forward "\t 0-9") |
(skip-chars-forward "\t 0-9") |
2707 |
(setq file-type (following-char) |
(setq file-type (following-char) |
2708 |
directory (eq file-type ?d)) |
directory (eq file-type ?d)) |
2709 |
(if (eq file-type ?l) |
(if (eq file-type ?l) |
2710 |
(if (string-match " -> " file) |
(let ((end (string-match " -> " file))) |
2711 |
(setq symlink (substring file (match-end 0)) |
(if end |
2712 |
file (substring file 0 (match-beginning 0))) |
;; Sometimes `ls' appends a @ at the end of the target. |
2713 |
;; Shouldn't happen |
(setq symlink (substring file (match-end 0) |
2714 |
(setq symlink "")) |
(string-match "@\\'" file)) |
2715 |
(setq symlink nil)) |
file (substring file 0 end)) |
2716 |
;; Only do a costly regexp search if the F switch was used. |
;; Shouldn't happen |
2717 |
(if (and used-F |
(setq symlink ""))) |
2718 |
(not (string-equal file "")) |
(setq symlink nil)) |
2719 |
(looking-at |
;; Only do a costly regexp search if the F switch was used. |
2720 |
".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)")) |
(if (and used-F |
2721 |
(let ((socket (eq file-type ?s)) |
(not (string-equal file "")) |
2722 |
(executable |
(looking-at |
2723 |
(and (not symlink) ; x bits don't mean a thing for symlinks |
".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)")) |
2724 |
(string-match |
(let ((socket (eq file-type ?s)) |
2725 |
"[xst]" |
(executable |
2726 |
(concat (buffer-substring |
(and (not symlink) ; x bits don't mean a thing for symlinks |
2727 |
(match-beginning 1) (match-end 1)) |
(string-match |
2728 |
(buffer-substring |
"[xst]" |
2729 |
(match-beginning 2) (match-end 2)) |
(concat (match-string 1) |
2730 |
(buffer-substring |
(match-string 2) |
2731 |
(match-beginning 3) (match-end 3))))))) |
(match-string 3)))))) |
2732 |
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) |
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) |
2733 |
;; and others don't. (sigh...) Beware, that some Unix's don't |
;; and others don't. (sigh...) Beware, that some Unix's don't |
2734 |
;; seem to believe in the F-switch |
;; seem to believe in the F-switch |
2735 |
(if (or (and symlink (string-match "@$" file)) |
(if (or (and symlink (string-match "@$" file)) |
2736 |
(and directory (string-match "/$" file)) |
(and directory (string-match "/$" file)) |
2737 |
(and executable (string-match "*$" file)) |
(and executable (string-match "*$" file)) |
2738 |
(and socket (string-match "=$" file))) |
(and socket (string-match "=$" file))) |
2739 |
(setq file (substring file 0 -1))))) |
(setq file (substring file 0 -1))))) |
2740 |
(ange-ftp-put-hash-entry file (or symlink directory) tbl) |
(puthash file (or symlink directory) tbl) |
2741 |
(forward-line 1)) |
(forward-line 1)) |
2742 |
(ange-ftp-put-hash-entry "." t tbl) |
(puthash "." t tbl) |
2743 |
(ange-ftp-put-hash-entry ".." t tbl) |
(puthash ".." t tbl) |
2744 |
tbl)) |
tbl)) |
2745 |
|
|
2746 |
;;; The dl stuff for descriptive listings |
;;; The dl stuff for descriptive listings |
2767 |
(defmacro ange-ftp-dl-parser () |
(defmacro ange-ftp-dl-parser () |
2768 |
;; Parse the current buffer, which is assumed to be a descriptive |
;; Parse the current buffer, which is assumed to be a descriptive |
2769 |
;; listing, and return a hashtable. |
;; listing, and return a hashtable. |
2770 |
`(let ((tbl (ange-ftp-make-hashtable))) |
`(let ((tbl (make-hash-table :test 'equal))) |
2771 |
(while (not (eobp)) |
(while (not (eobp)) |
2772 |
(ange-ftp-put-hash-entry |
(puthash |
2773 |
(buffer-substring (point) |
(buffer-substring (point) |
2774 |
(progn |
(progn |
2775 |
(skip-chars-forward "^ /\n") |
(skip-chars-forward "^ /\n") |
2777 |
(eq (following-char) ?/) |
(eq (following-char) ?/) |
2778 |
tbl) |
tbl) |
2779 |
(forward-line 1)) |
(forward-line 1)) |
2780 |
(ange-ftp-put-hash-entry "." t tbl) |
(puthash "." t tbl) |
2781 |
(ange-ftp-put-hash-entry ".." t tbl) |
(puthash ".." t tbl) |
2782 |
tbl)) |
tbl)) |
2783 |
|
|
2784 |
;; Parse the current buffer which is assumed to be in a dired-like listing |
;; Parse the current buffer which is assumed to be in a dired-like listing |
2785 |
;; format, and return a hashtable as the result. If the listing is not really |
;; format, and return a hashtable as the result. If the listing is not really |
2792 |
(forward-line 1) |
(forward-line 1) |
2793 |
;; Some systems put in a blank line here. |
;; Some systems put in a blank line here. |
2794 |
(if (eolp) (forward-line 1)) |
(if (eolp) (forward-line 1)) |
2795 |
(ange-ftp-ls-parser)) |
(ange-ftp-ls-parser switches)) |
2796 |
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") |
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") |
2797 |
;; It's an ls error message. |
;; It's an ls error message. |
2798 |
nil) |
nil) |
2806 |
nil) |
nil) |
2807 |
((re-search-forward ange-ftp-date-regexp nil t) |
((re-search-forward ange-ftp-date-regexp nil t) |
2808 |
(beginning-of-line) |
(beginning-of-line) |
2809 |
(ange-ftp-ls-parser)) |
(ange-ftp-ls-parser switches)) |
2810 |
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t) |
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t) |
2811 |
;; It's a dl listing (I hope). |
;; It's a dl listing (I hope). |
2812 |
;; file is bound by the call to ange-ftp-ls |
;; file is bound by the call to ange-ftp-ls |
2817 |
|
|
2818 |
(defun ange-ftp-set-files (directory files) |
(defun ange-ftp-set-files (directory files) |
2819 |
"For a given DIRECTORY, set or change the associated FILES hashtable." |
"For a given DIRECTORY, set or change the associated FILES hashtable." |
2820 |
(and files (ange-ftp-put-hash-entry (file-name-as-directory directory) |
(and files (puthash (file-name-as-directory directory) |
2821 |
files ange-ftp-files-hashtable))) |
files ange-ftp-files-hashtable))) |
2822 |
|
|
2823 |
(defun ange-ftp-get-files (directory &optional no-error) |
(defun ange-ftp-get-files (directory &optional no-error) |
2824 |
"Given a given DIRECTORY, return a hashtable of file entries. |
"Given a given DIRECTORY, return a hashtable of file entries. |
2825 |
This will give an error or return nil, depending on the value of |
This will give an error or return nil, depending on the value of |
2826 |
NO-ERROR, if a listing for DIRECTORY cannot be obtained." |
NO-ERROR, if a listing for DIRECTORY cannot be obtained." |
2827 |
(setq directory (file-name-as-directory directory)) ;normalize |
(setq directory (file-name-as-directory directory)) ;normalize |
2828 |
(or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable) |
(or (gethash directory ange-ftp-files-hashtable) |
2829 |
(save-match-data |
(save-match-data |
2830 |
(and (ange-ftp-ls directory |
(and (ange-ftp-ls directory |
2831 |
;; This is an efficiency hack. We try to |
;; This is an efficiency hack. We try to |
2856 |
dired-listing-switches |
dired-listing-switches |
2857 |
"-al")) |
"-al")) |
2858 |
t no-error) |
t no-error) |
2859 |
(ange-ftp-get-hash-entry |
(gethash directory ange-ftp-files-hashtable))))) |
|
directory ange-ftp-files-hashtable))))) |
|
2860 |
|
|
2861 |
;; Given NAME, return the file part that can be used for looking up the |
;; Given NAME, return the file part that can be used for looking up the |
2862 |
;; file's entry in a hashtable. |
;; file's entry in a hashtable. |
2863 |
(defmacro ange-ftp-get-file-part (name) |
(defmacro ange-ftp-get-file-part (name) |
2864 |
`(let ((file (file-name-nondirectory ,name))) |
`(let ((file (file-name-nondirectory ,name))) |
2865 |
(if (string-equal file "") |
(if (string-equal file "") |
2866 |
"." |
"." |
2867 |
file))) |
file))) |
2868 |
|
|
2869 |
;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are |
;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are |
2874 |
;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid |
;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid |
2875 |
;; subdirectory. This is of course an OS dependent judgement. |
;; subdirectory. This is of course an OS dependent judgement. |
2876 |
|
|
2877 |
|
(defvar dired-local-variables-file) |
2878 |
(defmacro ange-ftp-allow-child-lookup (dir file) |
(defmacro ange-ftp-allow-child-lookup (dir file) |
2879 |
`(not |
`(not |
2880 |
(let* ((efile ,file) ; expand once. |
(let* ((efile ,file) ; expand once. |
2901 |
"Given NAME, return whether there is a file entry for it." |
"Given NAME, return whether there is a file entry for it." |
2902 |
(let* ((name (directory-file-name name)) |
(let* ((name (directory-file-name name)) |
2903 |
(dir (file-name-directory name)) |
(dir (file-name-directory name)) |
2904 |
(ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable)) |
(ent (gethash dir ange-ftp-files-hashtable)) |
2905 |
(file (ange-ftp-get-file-part name))) |
(file (ange-ftp-get-file-part name))) |
2906 |
(if ent |
(if ent |
2907 |
(ange-ftp-hash-entry-exists-p file ent) |
(ange-ftp-hash-entry-exists-p file ent) |
2915 |
;; then dumb hosts will give an ftp error. Smart unix hosts |
;; then dumb hosts will give an ftp error. Smart unix hosts |
2916 |
;; will simply send back the ls |
;; will simply send back the ls |
2917 |
;; error message. |
;; error message. |
2918 |
(ange-ftp-get-hash-entry "." ent)) |
(gethash "." ent)) |
2919 |
;; Child lookup failed, so try the parent. |
;; Child lookup failed, so try the parent. |
2920 |
(let ((table (ange-ftp-get-files dir))) |
(let ((table (ange-ftp-get-files dir 'no-error))) |
2921 |
;; If the dir doesn't exist, don't use it as a hash table. |
;; If the dir doesn't exist, don't use it as a hash table. |
2922 |
(and table |
(and table |
2923 |
(ange-ftp-hash-entry-exists-p file |
(ange-ftp-hash-entry-exists-p file |
2930 |
this also returns nil." |
this also returns nil." |
2931 |
(let* ((name (directory-file-name name)) |
(let* ((name (directory-file-name name)) |
2932 |
(dir (file-name-directory name)) |
(dir (file-name-directory name)) |
2933 |
(ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable)) |
(ent (gethash dir ange-ftp-files-hashtable)) |
2934 |
(file (ange-ftp-get-file-part name))) |
(file (ange-ftp-get-file-part name))) |
2935 |
(if ent |
(if ent |
2936 |
(ange-ftp-get-hash-entry file ent) |
(gethash file ent) |
2937 |
(or (and (ange-ftp-allow-child-lookup dir file) |
(or (and (ange-ftp-allow-child-lookup dir file) |
2938 |
(setq ent (ange-ftp-get-files name t)) |
(setq ent (ange-ftp-get-files name t)) |
2939 |
(ange-ftp-get-hash-entry "." ent)) |
(gethash "." ent)) |
2940 |
;; i.e. it's a directory by child lookup |
;; i.e. it's a directory by child lookup |
2941 |
(ange-ftp-get-hash-entry file |
(and (setq ent (ange-ftp-get-files dir t)) |
2942 |
(ange-ftp-get-files dir)))))) |
(gethash file ent)))))) |
2943 |
|
|
2944 |
(defun ange-ftp-internal-delete-file-entry (name &optional dir-p) |
(defun ange-ftp-internal-delete-file-entry (name &optional dir-p) |
2945 |
(if dir-p |
(when dir-p |
2946 |
(progn |
(setq name (file-name-as-directory name)) |
2947 |
(setq name (file-name-as-directory name)) |
(remhash name ange-ftp-files-hashtable) |
2948 |
(ange-ftp-del-hash-entry name ange-ftp-files-hashtable) |
(setq name (directory-file-name name))) |
|
(setq name (directory-file-name name)))) |
|
2949 |
;; Note that file-name-as-directory followed by directory-file-name |
;; Note that file-name-as-directory followed by directory-file-name |
2950 |
;; serves to canonicalize directory file names to their unix form. |
;; serves to canonicalize directory file names to their unix form. |
2951 |
;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO |
;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO |
2952 |
(let ((files (ange-ftp-get-hash-entry (file-name-directory name) |
(let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable))) |
|
ange-ftp-files-hashtable))) |
|
2953 |
(if files |
(if files |
2954 |
(ange-ftp-del-hash-entry (ange-ftp-get-file-part name) |
(remhash (ange-ftp-get-file-part name) files)))) |
|
files)))) |
|
2955 |
|
|
2956 |
(defun ange-ftp-internal-add-file-entry (name &optional dir-p) |
(defun ange-ftp-internal-add-file-entry (name &optional dir-p) |
2957 |
(and dir-p |
(and dir-p |
2958 |
(setq name (directory-file-name name))) |
(setq name (directory-file-name name))) |
2959 |
(let ((files (ange-ftp-get-hash-entry (file-name-directory name) |
(let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable))) |
|
ange-ftp-files-hashtable))) |
|
2960 |
(if files |
(if files |
2961 |
(ange-ftp-put-hash-entry (ange-ftp-get-file-part name) |
(puthash (ange-ftp-get-file-part name) dir-p files)))) |
|
dir-p |
|
|
files)))) |
|
2962 |
|
|
2963 |
(defun ange-ftp-wipe-file-entries (host user) |
(defun ange-ftp-wipe-file-entries (host user) |
2964 |
"Get rid of entry for HOST, USER pair from file entry information hashtable." |
"Get rid of entry for HOST, USER pair from file entry information hashtable." |
2965 |
(let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable)))) |
(let ((new-tbl (make-hash-table :test 'equal |
2966 |
(ange-ftp-map-hashtable |
:size (hash-table-size |
2967 |
|
ange-ftp-files-hashtable)))) |
2968 |
|
(maphash |
2969 |
(lambda (key val) |
(lambda (key val) |
2970 |
(let ((parsed (ange-ftp-ftp-name key))) |
(let ((parsed (ange-ftp-ftp-name key))) |
2971 |
(if parsed |
(if parsed |
2972 |
(let ((h (nth 0 parsed)) |
(let ((h (nth 0 parsed)) |
2973 |
(u (nth 1 parsed))) |
(u (nth 1 parsed))) |
2974 |
(or (and (equal host h) (equal user u)) |
(or (and (equal host h) (equal user u)) |
2975 |
(ange-ftp-put-hash-entry key val new-tbl)))))) |
(puthash key val new-tbl)))))) |
2976 |
ange-ftp-files-hashtable) |
ange-ftp-files-hashtable) |
2977 |
(setq ange-ftp-files-hashtable new-tbl))) |
(setq ange-ftp-files-hashtable new-tbl))) |
2978 |
|
|
3018 |
(if (car result) |
(if (car result) |
3019 |
(save-match-data |
(save-match-data |
3020 |
(and (or (string-match "\"\\([^\"]*\\)\"" line) |
(and (or (string-match "\"\\([^\"]*\\)\"" line) |
3021 |
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! |
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! |
3022 |
(setq dir (substring line |
(setq dir (match-string 1 line))))) |
|
(match-beginning 1) |
|
|
(match-end 1)))))) |
|
3023 |
(cons dir line))) |
(cons dir line))) |
3024 |
|
|
3025 |
;;; ------------------------------------------------------------ |
;;; ------------------------------------------------------------ |
3037 |
(fix-name-func |
(fix-name-func |
3038 |
(cdr (assq host-type ange-ftp-fix-name-func-alist))) |
(cdr (assq host-type ange-ftp-fix-name-func-alist))) |
3039 |
(key (concat host "/" user "/" dir)) |
(key (concat host "/" user "/" dir)) |
3040 |
(res (ange-ftp-get-hash-entry key ange-ftp-expand-dir-hashtable))) |
(res (gethash key ange-ftp-expand-dir-hashtable))) |
3041 |
(or res |
(or res |
3042 |
(progn |
(progn |
3043 |
(or |
(or |
3053 |
(line (cdr result))) |
(line (cdr result))) |
3054 |
(setq res |
(setq res |
3055 |
(if (string-match ange-ftp-expand-dir-regexp line) |
(if (string-match ange-ftp-expand-dir-regexp line) |
3056 |
(substring line |
(match-string 1 line))))) |
|
(match-beginning 1) |
|
|
(match-end 1)))))) |
|
3057 |
(or res |
(or res |
3058 |
(if (string-equal dir "~") |
(if (string-equal dir "~") |
3059 |
(setq res (car (ange-ftp-get-pwd host user))) |
(setq res (car (ange-ftp-get-pwd host user))) |
3067 |
(ange-ftp-this-host host)) |
(ange-ftp-this-host host)) |
3068 |
(if fix-name-func |
(if fix-name-func |
3069 |
(setq res (funcall fix-name-func res 'reverse))) |
(setq res (funcall fix-name-func res 'reverse))) |
3070 |
(ange-ftp-put-hash-entry |
(puthash key res ange-ftp-expand-dir-hashtable))) |
|
key res ange-ftp-expand-dir-hashtable))) |
|
3071 |
res)))) |
res)))) |
3072 |
|
|
3073 |
(defun ange-ftp-canonize-filename (n) |
(defun ange-ftp-canonize-filename (n) |
3088 |
;; Name starts with ~ or ~user. Resolve that part of the name |
;; Name starts with ~ or ~user. Resolve that part of the name |
3089 |
;; making it absolute then re-expand it. |
;; making it absolute then re-expand it. |
3090 |
((string-match "^~[^/]*" name) |
((string-match "^~[^/]*" name) |
3091 |
(let* ((tilda (substring name |
(let* ((tilda (match-string 0 name)) |
|
(match-beginning 0) |
|
|
(match-end 0))) |
|
3092 |
(rest (substring name (match-end 0))) |
(rest (substring name (match-end 0))) |
3093 |
(dir (ange-ftp-expand-dir host user tilda))) |
(dir (ange-ftp-expand-dir host user tilda))) |
3094 |
(if dir |
(if dir |
3200 |
(let ((parsed (ange-ftp-ftp-name dir))) |
(let ((parsed (ange-ftp-ftp-name dir))) |
3201 |
(if parsed |
(if parsed |
3202 |
(ange-ftp-replace-name-component |
(ange-ftp-replace-name-component |
3203 |
dir |
dir |
3204 |
(ange-ftp-real-directory-file-name (nth 2 parsed))) |
(ange-ftp-real-directory-file-name (nth 2 parsed))) |
3205 |
(ange-ftp-real-directory-file-name dir)))) |
(ange-ftp-real-directory-file-name dir)))) |
3206 |
|
|
3207 |
|
|
3237 |
(coding-system-used last-coding-system-used)) |
(coding-system-used last-coding-system-used)) |
3238 |
(unwind-protect |
(unwind-protect |
3239 |
(progn |
(progn |
3240 |
(let ((executing-kbd-macro t) |
(let ((filename (buffer-file-name)) |
|
(filename (buffer-file-name)) |
|
3241 |
(mod-p (buffer-modified-p))) |
(mod-p (buffer-modified-p))) |
3242 |
(unwind-protect |
(unwind-protect |
3243 |
(progn |
(progn |
3244 |
(ange-ftp-real-write-region start end temp nil visit) |
(ange-ftp-real-write-region start end temp nil |
3245 |
|
(or visit 'quiet)) |
3246 |
(setq coding-system-used last-coding-system-used)) |
(setq coding-system-used last-coding-system-used)) |
3247 |
;; cleanup forms |
;; cleanup forms |
3248 |
(setq coding-system-used last-coding-system-used) |
(setq coding-system-used last-coding-system-used) |
3292 |
(if (or (file-exists-p filename) |
(if (or (file-exists-p filename) |
3293 |
(progn |
(progn |
3294 |
(setq ange-ftp-ls-cache-file nil) |
(setq ange-ftp-ls-cache-file nil) |
3295 |
(ange-ftp-del-hash-entry (file-name-directory filename) |
(remhash (file-name-directory filename) |
3296 |
ange-ftp-files-hashtable) |
ange-ftp-files-hashtable) |
3297 |
(file-exists-p filename))) |
(file-exists-p filename))) |
3298 |
(let* ((host (nth 0 parsed)) |
(let* ((host (nth 0 parsed)) |
3299 |
(user (nth 1 parsed)) |
(user (nth 1 parsed)) |
3367 |
(setq file (ange-ftp-expand-file-name file)) |
(setq file (ange-ftp-expand-file-name file)) |
3368 |
(if (ange-ftp-ftp-name file) |
(if (ange-ftp-ftp-name file) |
3369 |
(let ((file-ent |
(let ((file-ent |
3370 |
(ange-ftp-get-hash-entry |
(gethash |
3371 |
(ange-ftp-get-file-part file) |
(ange-ftp-get-file-part file) |
3372 |
(ange-ftp-get-files (file-name-directory file))))) |
(ange-ftp-get-files (file-name-directory file))))) |
3373 |
(if (stringp file-ent) |
(if (stringp file-ent) |
3374 |
(if (file-name-absolute-p file-ent) |
(if (file-name-absolute-p file-ent) |
3375 |
(ange-ftp-replace-name-component |
(ange-ftp-replace-name-component |
3376 |
(file-name-directory file) file-ent) |
(file-name-directory file) file-ent) |
3377 |
file-ent))) |
file-ent))) |
3378 |
(ange-ftp-real-file-symlink-p file))) |
(ange-ftp-real-file-symlink-p file))) |
3379 |
|
|
3436 |
(let ((host (nth 0 parsed)) |
(let ((host (nth 0 parsed)) |
3437 |
(user (nth 1 parsed)) |
(user (nth 1 parsed)) |
3438 |
(name (nth 2 parsed)) |
(name (nth 2 parsed)) |
3439 |
(dirp (ange-ftp-get-hash-entry part files)) |
(dirp (gethash part files)) |
3440 |
(inode (ange-ftp-get-hash-entry |
(inode (gethash file ange-ftp-inodes-hashtable))) |
|
file ange-ftp-inodes-hashtable))) |
|
3441 |
(unless inode |
(unless inode |
3442 |
(setq inode ange-ftp-next-inode-number |
(setq inode ange-ftp-next-inode-number |
3443 |
ange-ftp-next-inode-number (1+ inode)) |
ange-ftp-next-inode-number (1+ inode)) |
3444 |
(ange-ftp-put-hash-entry file inode ange-ftp-inodes-hashtable)) |
(puthash file inode ange-ftp-inodes-hashtable)) |
3445 |
(list (if (and (stringp dirp) (file-name-absolute-p dirp)) |
(list (if (and (stringp dirp) (file-name-absolute-p dirp)) |
3446 |
(ange-ftp-expand-symlink dirp |
(ange-ftp-expand-symlink dirp |
3447 |
(file-name-directory file)) |
(file-name-directory file)) |
3583 |
;; filename |
;; filename |
3584 |
;; newname)) |
;; newname)) |
3585 |
;; res) |
;; res) |
3586 |
;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel)) |
;; (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel) |
3587 |
;; (process-kill-without-query proc) |
;; (process-kill-without-query proc) |
3588 |
;; (with-current-buffer (process-buffer proc) |
;; (with-current-buffer (process-buffer proc) |
3589 |
;; (set (make-local-variable 'copy-cont) cont)))) |
;; (set (make-local-variable 'copy-cont) cont)))) |
3671 |
(if (and temp1 t-parsed) |
(if (and temp1 t-parsed) |
3672 |
(format "Getting %s" f-abbr) |
(format "Getting %s" f-abbr) |
3673 |
(format "Copying %s to %s" f-abbr t-abbr))) |
(format "Copying %s to %s" f-abbr t-abbr))) |
3674 |
(list (function ange-ftp-cf1) |
(list 'ange-ftp-cf1 |
3675 |
filename newname binary msg |
filename newname binary msg |
3676 |
f-parsed f-host f-user f-name f-abbr |
f-parsed f-host f-user f-name f-abbr |
3677 |
t-parsed t-host t-user t-name t-abbr |
t-parsed t-host t-user t-name t-abbr |
3749 |
(if (and temp2 f-parsed) |
(if (and temp2 f-parsed) |
3750 |
(format "Putting %s" newname) |
(format "Putting %s" newname) |
3751 |
(format "Copying %s to %s" f-abbr t-abbr))) |
(format "Copying %s to %s" f-abbr t-abbr))) |
3752 |
(list (function ange-ftp-cf2) |
(list 'ange-ftp-cf2 |
3753 |
newname t-host t-user binary temp1 temp2 cont) |
newname t-host t-user binary temp1 temp2 cont) |
3754 |
nowait)) |
nowait)) |
3755 |
|
|
3824 |
(and verbose-p (format "%s --> %s" from-file to-file)) |
(and verbose-p (format "%s --> %s" from-file to-file)) |
3825 |
(list 'ange-ftp-copy-files-async verbose-p (cdr files)) |
(list 'ange-ftp-copy-files-async verbose-p (cdr files)) |
3826 |
t)) |
t)) |
3827 |
(message "%s: done" 'ange-ftp-copy-files-async))) |
(message "%s: done" 'ange-ftp-copy-files-async))) |
3828 |
|
|
3829 |
|
|
3830 |
;;;; ------------------------------------------------------------ |
;;;; ------------------------------------------------------------ |
3904 |
;;;; File name completion support. |
;;;; File name completion support. |
3905 |
;;;; ------------------------------------------------------------ |
;;;; ------------------------------------------------------------ |
3906 |
|
|
|
;; If the file entry SYM is a symlink, returns whether its file exists. |
|
|
;; Note that `ange-ftp-this-dir' is used as a free variable. |
|
|
(defun ange-ftp-file-entry-active-p (sym) |
|
|
(let ((val (get sym 'val))) |
|
|
(or (not (stringp val)) |
|
|
(file-exists-p (ange-ftp-expand-symlink val ange-ftp-this-dir))))) |
|
|
|
|
3907 |
;; If the file entry is not a directory (nor a symlink pointing to a directory) |
;; If the file entry is not a directory (nor a symlink pointing to a directory) |
3908 |
;; returns whether the file (or file pointed to by the symlink) is ignored |
;; returns whether the file (or file pointed to by the symlink) is ignored |
3909 |
;; by completion-ignored-extensions. |
;; by completion-ignored-extensions. |
3910 |
;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern' |
;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern' |
3911 |
;; are used as free variables. |
;; are used as free variables. |
3912 |
(defun ange-ftp-file-entry-not-ignored-p (sym) |
(defun ange-ftp-file-entry-not-ignored-p (symname val) |
3913 |
(let ((val (get sym 'val)) |
(if (stringp val) |
3914 |
(symname (symbol-name sym))) |
(let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir))) |
3915 |
(if (stringp val) |
(or (file-directory-p file) |
3916 |
(let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir))) |
(and (file-exists-p file) |
3917 |
(or (file-directory-p file) |
(not (string-match ange-ftp-completion-ignored-pattern |
3918 |
(and (file-exists-p file) |
symname))))) |
3919 |
(not (string-match ange-ftp-completion-ignored-pattern |
(or val ; is a directory name |
3920 |
symname))))) |
(not (string-match ange-ftp-completion-ignored-pattern symname))))) |
|
(or val ; is a directory name |
|
|
(not (string-match ange-ftp-completion-ignored-pattern symname)))))) |
|
3921 |
|
|
3922 |
(defun ange-ftp-root-dir-p (dir) |
(defun ange-ftp-root-dir-p (dir) |
3923 |
;; Maybe we should use something more like |
;; Maybe we should use something more like |
3934 |
(setq ange-ftp-this-dir |
(setq ange-ftp-this-dir |
3935 |
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) |
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) |
3936 |
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) |
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) |
3937 |
(completions |
(completions (all-completions file tbl))) |
|
(all-completions file tbl |
|
|
(function ange-ftp-file-entry-active-p)))) |
|
3938 |
|
|
3939 |
;; see whether each matching file is a directory or not... |
;; see whether each matching file is a directory or not... |
3940 |
(mapcar |
(mapcar |
3941 |
(lambda (file) |
(lambda (file) |
3942 |
(let ((ent (ange-ftp-get-hash-entry file tbl))) |
(let ((ent (gethash file tbl))) |
3943 |
(if (and ent |
(if (and ent |
3944 |
(or (not (stringp ent)) |
(or (not (stringp ent)) |
3945 |
(file-directory-p |
(file-directory-p |
3946 |
(ange-ftp-expand-symlink ent |
(ange-ftp-expand-symlink ent |
3947 |
ange-ftp-this-dir)))) |
ange-ftp-this-dir)))) |
3948 |
(concat file "/") |
(concat file "/") |
3949 |
file))) |
file))) |
3950 |
completions))) |
completions))) |
3951 |
|
|
3952 |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
3974 |
(save-match-data |
(save-match-data |
3975 |
(or (ange-ftp-file-name-completion-1 |
(or (ange-ftp-file-name-completion-1 |
3976 |
file tbl ange-ftp-this-dir |
file tbl ange-ftp-this-dir |
3977 |
(function ange-ftp-file-entry-not-ignored-p)) |
'ange-ftp-file-entry-not-ignored-p) |
3978 |
(ange-ftp-file-name-completion-1 |
(ange-ftp-file-name-completion-1 |
3979 |
file tbl ange-ftp-this-dir |
file tbl ange-ftp-this-dir)))))) |
|
(function ange-ftp-file-entry-active-p))))))) |
|
3980 |
|
|
3981 |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
3982 |
(try-completion |
(try-completion |
3987 |
(ange-ftp-real-file-name-completion file ange-ftp-this-dir))))) |
(ange-ftp-real-file-name-completion file ange-ftp-this-dir))))) |
3988 |
|
|
3989 |
|
|
3990 |
(defun ange-ftp-file-name-completion-1 (file tbl dir predicate) |
(defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate) |
3991 |
(let ((bestmatch (try-completion file tbl predicate))) |
(let ((bestmatch (try-completion file tbl predicate))) |
3992 |
(if bestmatch |
(if bestmatch |
3993 |
(if (eq bestmatch t) |
(if (eq bestmatch t) |
4023 |
(if (ange-ftp-ftp-name dir) |
(if (ange-ftp-ftp-name dir) |
4024 |
(progn |
(progn |
4025 |
(setq ange-ftp-ls-cache-file nil) |
(setq ange-ftp-ls-cache-file nil) |
4026 |
(ange-ftp-del-hash-entry dir ange-ftp-files-hashtable) |
(remhash dir ange-ftp-files-hashtable) |
4027 |
(ange-ftp-get-files dir t)))) |
(ange-ftp-get-files dir t)))) |
4028 |
|
|
4029 |
(defun ange-ftp-make-directory (dir &optional parents) |
(defun ange-ftp-make-directory (dir &optional parents) |
4080 |
(nth 2 parsed)) |
(nth 2 parsed)) |
4081 |
(ange-ftp-real-file-name-as-directory |
(ange-ftp-real-file-name-as-directory |
4082 |
(nth 2 parsed))))) |
(nth 2 parsed))))) |
4083 |
(abbr (ange-ftp-abbreviate-filename dir)) |
(abbr (ange-ftp-abbreviate-filename dir)) |
4084 |
(result (ange-ftp-send-cmd host user |
(result (ange-ftp-send-cmd host user |
4085 |
(list 'rmdir name) |
(list 'rmdir name) |
4086 |
(format "Removing directory %s" |
(format "Removing directory %s" |
4087 |
abbr)))) |
abbr)))) |
4088 |
(or (car result) |
(or (car result) |
4089 |
(ange-ftp-error host user |
(ange-ftp-error host user |
4090 |
(format "Could not remove directory %s: %s" |
(format "Could not remove directory %s: %s" |
4246 |
(let ((fn (get operation 'ange-ftp))) |
(let ((fn (get operation 'ange-ftp))) |
4247 |
(if fn (save-match-data (apply fn args)) |
(if fn (save-match-data (apply fn args)) |
4248 |
(ange-ftp-run-real-handler operation args)))) |
(ange-ftp-run-real-handler operation args)))) |
|
|
|
|
|
|
|
;;; This regexp takes care of real ange-ftp file names (with a slash |
|
|
;;; and colon). |
|
|
;;; Don't allow the host name to end in a period--some systems use /.: |
|
4249 |
;;;###autoload |
;;;###autoload |
4250 |
(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) |
;;; These file names are remote file names. |
4251 |
(setq file-name-handler-alist |
(put 'ange-ftp-hook-function 'file-remote-p t) |
|
(cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) |
|
|
file-name-handler-alist))) |
|
4252 |
|
|
4253 |
;;; This regexp recognizes absolute filenames with only one component, |
;; The following code is commented out because Tramp now deals with |
4254 |
;;; for the sake of hostname completion. |
;; Ange-FTP filenames, too. |
4255 |
;;;###autoload |
|
4256 |
(or (assoc "^/[^/:]*\\'" file-name-handler-alist) |
;;-;;; This regexp takes care of real ange-ftp file names (with a slash |
4257 |
(setq file-name-handler-alist |
;;-;;; and colon). |
4258 |
(cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) |
;;-;;; Don't allow the host name to end in a period--some systems use /.: |
4259 |
file-name-handler-alist))) |
;;-;;;###autoload |
4260 |
|
;;-(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) |
4261 |
;;; This regexp recognizes absolute filenames with only one component |
;;- (setq file-name-handler-alist |
4262 |
;;; on Windows, for the sake of hostname completion. |
;;- (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) |
4263 |
;;; NB. Do not mark this as autoload, because it is very common to |
;;- file-name-handler-alist))) |
4264 |
;;; do completions in the root directory of drives on Windows. |
;;- |
4265 |
(and (memq system-type '(ms-dos windows-nt)) |
;;-;;; This regexp recognizes absolute filenames with only one component, |
4266 |
(or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist) |
;;-;;; for the sake of hostname completion. |
4267 |
(setq file-name-handler-alist |
;;-;;;###autoload |
4268 |
(cons '("^[a-zA-Z]:/[^/:]*\\'" . |
;;-(or (assoc "^/[^/:]*\\'" file-name-handler-alist) |
4269 |
ange-ftp-completion-hook-function) |
;;- (setq file-name-handler-alist |
4270 |
file-name-handler-alist)))) |
;;- (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) |
4271 |
|
;;- file-name-handler-alist))) |
4272 |
|
;;- |
4273 |
|
;;-;;; This regexp recognizes absolute filenames with only one component |
4274 |
|
;;-;;; on Windows, for the sake of hostname completion. |
4275 |
|
;;-;;; NB. Do not mark this as autoload, because it is very common to |
4276 |
|
;;-;;; do completions in the root directory of drives on Windows. |
4277 |
|
;;-(and (memq system-type '(ms-dos windows-nt)) |
4278 |
|
;;- (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist) |
4279 |
|
;;- (setq file-name-handler-alist |
4280 |
|
;;- (cons '("^[a-zA-Z]:/[^/:]*\\'" . |
4281 |
|
;;- ange-ftp-completion-hook-function) |
4282 |
|
;;- file-name-handler-alist)))) |
4283 |
|
|
4284 |
;;; The above two forms are sufficient to cause this file to be loaded |
;;; The above two forms are sufficient to cause this file to be loaded |
4285 |
;;; if the user ever uses a file name with a colon in it. |
;;; if the user ever uses a file name with a colon in it. |
4286 |
|
|
4287 |
;;; This sets the mode |
;;; This sets the mode |
4288 |
(or (memq 'ange-ftp-set-buffer-mode find-file-hooks) |
(add-hook 'find-file-hook 'ange-ftp-set-buffer-mode) |
|
(setq find-file-hooks |
|
|
(cons 'ange-ftp-set-buffer-mode find-file-hooks))) |
|
4289 |
|
|
4290 |
;;; Now say where to find the handlers for particular operations. |
;;; Now say where to find the handlers for particular operations. |
4291 |
|
|
4308 |
'ange-ftp-verify-visited-file-modtime) |
'ange-ftp-verify-visited-file-modtime) |
4309 |
(put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p) |
(put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p) |
4310 |
(put 'write-region 'ange-ftp 'ange-ftp-write-region) |
(put 'write-region 'ange-ftp 'ange-ftp-write-region) |
|
(put 'backup-buffer 'ange-ftp 'ange-ftp-backup-buffer) |
|
4311 |
(put 'copy-file 'ange-ftp 'ange-ftp-copy-file) |
(put 'copy-file 'ange-ftp 'ange-ftp-copy-file) |
4312 |
(put 'rename-file 'ange-ftp 'ange-ftp-rename-file) |
(put 'rename-file 'ange-ftp 'ange-ftp-rename-file) |
4313 |
(put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes) |
(put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes) |
4420 |
;; I have preserved (and modernized) those hooks. |
;; I have preserved (and modernized) those hooks. |
4421 |
;; So the format conversion should be all that is needed. |
;; So the format conversion should be all that is needed. |
4422 |
|
|
4423 |
|
;; When called from dired, SWITCHES may start with "--dired". |
4424 |
|
;; `ange-ftp-ls' handles this. |
4425 |
|
|
4426 |
(defun ange-ftp-insert-directory (file switches &optional wildcard full) |
(defun ange-ftp-insert-directory (file switches &optional wildcard full) |
4427 |
(let ((short (ange-ftp-abbreviate-filename file)) |
(let ((short (ange-ftp-abbreviate-filename file)) |
4428 |
(parsed (ange-ftp-ftp-name (expand-file-name file))) |
(parsed (ange-ftp-ftp-name (expand-file-name file))) |
4431 |
(if (and (not wildcard) |
(if (and (not wildcard) |
4432 |
(setq tem (file-symlink-p (directory-file-name file)))) |
(setq tem (file-symlink-p (directory-file-name file)))) |
4433 |
(ange-ftp-insert-directory |
(ange-ftp-insert-directory |
4434 |
(ange-ftp-replace-name-component file tem) |
(ange-ftp-expand-symlink |
4435 |
|
tem (file-name-directory (directory-file-name file))) |
4436 |
switches wildcard full) |
switches wildcard full) |
4437 |
(insert |
(insert |
4438 |
(if wildcard |
(if wildcard |
4496 |
;; ((equal dired-chown-program program)) |
;; ((equal dired-chown-program program)) |
4497 |
(t (error "Unknown remote command: %s" program))) |
(t (error "Unknown remote command: %s" program))) |
4498 |
(ftp-error (insert (format "%s: %s, %s\n" |
(ftp-error (insert (format "%s: %s, %s\n" |
4499 |
(nth 1 oops) |
(nth 1 oops) |
4500 |
(nth 2 oops) |
(nth 2 oops) |
4501 |
(nth 3 oops))) |
(nth 3 oops))) |
4502 |
;; Caller expects nonzero value to mean failure. |
;; Caller expects nonzero value to mean failure. |
4503 |
1) |
1) |
4504 |
(error (insert (format "%s\n" (nth 1 oops))) |
(error (insert (format "%s\n" (nth 1 oops))) |
4649 |
;; (t nil)))) |
;; (t nil)))) |
4650 |
;; (condition-case err |
;; (condition-case err |
4651 |
;; (funcall file-creator from to overwrite-confirmed |
;; (funcall file-creator from to overwrite-confirmed |
4652 |
;; (list (function ange-ftp-dcf-2) |
;; (list 'ange-ftp-dcf-2 |
4653 |
;; nil ;err |
;; nil ;err |
4654 |
;; file-creator operation fn-list |
;; file-creator operation fn-list |
4655 |
;; name-constructor |
;; name-constructor |
4873 |
; (progn |
; (progn |
4874 |
; (end-of-line 1) |
; (end-of-line 1) |
4875 |
; (point)))) |
; (point)))) |
4876 |
; (ange-ftp-put-hash-entry file type-is-dir tbl) |
; (puthash file type-is-dir tbl) |
4877 |
; (forward-line 1)))) |
; (forward-line 1)))) |
4878 |
; (ange-ftp-put-hash-entry "." 'vosdir tbl) |
; (puthash "." 'vosdir tbl) |
4879 |
; (ange-ftp-put-hash-entry ".." 'vosdir tbl)) |
; (puthash ".." 'vosdir tbl)) |
4880 |
; tbl)) |
; tbl)) |
4881 |
; |
; |
4882 |
;(or (assq 'vos ange-ftp-parse-list-func-alist) |
;(or (assq 'vos ange-ftp-parse-list-func-alist) |
4895 |
(if reverse |
(if reverse |
4896 |
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) |
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) |
4897 |
(let (drive dir file) |
(let (drive dir file) |
4898 |
(if (match-beginning 1) |
(setq drive (match-string 1 name)) |
4899 |
(setq drive (substring name |
(setq dir (match-string 2 name)) |
4900 |
(match-beginning 1) |
(setq file (match-string 3 name)) |
|
(match-end 1)))) |
|
|
(if (match-beginning 2) |
|
|
(setq dir |
|
|
(substring name (match-beginning 2) (match-end 2)))) |
|
|
(if (match-beginning 3) |
|
|
(setq file |
|
|
(substring name (match-beginning 3) (match-end 3)))) |
|
4901 |
(and dir |
(and dir |
4902 |
(setq dir (subst-char-in-string |
(setq dir (subst-char-in-string |
4903 |
?/ ?. (substring dir 1 -1) t))) |
?/ ?. (substring dir 1 -1) t))) |
4983 |
;; Extract the next filename from a VMS dired-like listing. |
;; Extract the next filename from a VMS dired-like listing. |
4984 |
(defun ange-ftp-parse-vms-filename () |
(defun ange-ftp-parse-vms-filename () |
4985 |
(if (re-search-forward |
(if (re-search-forward |
4986 |
ange-ftp-vms-filename-regexp |
ange-ftp-vms-filename-regexp |
4987 |
nil t) |
nil t) |
4988 |
(buffer-substring (match-beginning 0) (match-end 0)))) |
(match-string 0))) |
4989 |
|
|
4990 |
;; Parse the current buffer which is assumed to be in MultiNet FTP dir |
;; Parse the current buffer which is assumed to be in MultiNet FTP dir |
4991 |
;; format, and return a hashtable as the result. |
;; format, and return a hashtable as the result. |
4992 |
(defun ange-ftp-parse-vms-listing () |
(defun ange-ftp-parse-vms-listing () |
4993 |
(let ((tbl (ange-ftp-make-hashtable)) |
(let ((tbl (make-hash-table :test 'equal)) |
4994 |
file) |
file) |
4995 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4996 |
(save-match-data |
(save-match-data |
4997 |
(while (setq file (ange-ftp-parse-vms-filename)) |
(while (setq file (ange-ftp-parse-vms-filename)) |
4998 |
(if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file) |
(if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file) |
4999 |
;; deal with directories |
;; deal with directories |
5000 |
(ange-ftp-put-hash-entry |
(puthash (substring file 0 (match-beginning 0)) t tbl) |
5001 |
(substring file 0 (match-beginning 0)) t tbl) |
(puthash file nil tbl) |
|
(ange-ftp-put-hash-entry file nil tbl) |
|
5002 |
(if (string-match ";[0-9]+$" file) ; deal with extension |
(if (string-match ";[0-9]+$" file) ; deal with extension |
5003 |
;; sans extension |
;; sans extension |
5004 |
(ange-ftp-put-hash-entry |
(puthash (substring file 0 (match-beginning 0)) nil tbl))) |
|
(substring file 0 (match-beginning 0)) nil tbl))) |
|
5005 |
(forward-line 1)) |
(forward-line 1)) |
5006 |
;; Would like to look for a "Total" line, or a "Directory" line to |
;; Would like to look for a "Total" line, or a "Directory" line to |
5007 |
;; make sure that the listing isn't complete garbage before putting |
;; make sure that the listing isn't complete garbage before putting |
5008 |
;; in "." and "..", but we can't even count on all VAX's giving us |
;; in "." and "..", but we can't even count on all VAX's giving us |
5009 |
;; either of these. |
;; either of these. |
5010 |
(ange-ftp-put-hash-entry "." t tbl) |
(puthash "." t tbl) |
5011 |
(ange-ftp-put-hash-entry ".." t tbl)) |
(puthash ".." t tbl)) |
5012 |
tbl)) |
tbl)) |
5013 |
|
|
5014 |
(or (assq 'vms ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5015 |
(setq ange-ftp-parse-list-func-alist |
'(vms . ange-ftp-parse-vms-listing)) |
|
(cons '(vms . ange-ftp-parse-vms-listing) |
|
|
ange-ftp-parse-list-func-alist))) |
|
5016 |
|
|
5017 |
;; This version only deletes file entries which have |
;; This version only deletes file entries which have |
5018 |
;; explicit version numbers, because that is all VMS allows. |
;; explicit version numbers, because that is all VMS allows. |
5029 |
;; In VMS you can't delete a file without an explicit |
;; In VMS you can't delete a file without an explicit |
5030 |
;; version number, or wild-card (e.g. FOO;*) |
;; version number, or wild-card (e.g. FOO;*) |
5031 |
;; For now, we give up on wildcards. |
;; For now, we give up on wildcards. |
5032 |
(let ((files (ange-ftp-get-hash-entry |
(let ((files (gethash (file-name-directory name) |
5033 |
(file-name-directory name) |
ange-ftp-files-hashtable))) |
|
ange-ftp-files-hashtable))) |
|
5034 |
(if files |
(if files |
5035 |
(let* ((root (substring file 0 |
(let* ((root (substring file 0 |
5036 |
(match-beginning 0))) |
(match-beginning 0))) |
5038 |
(regexp-quote root) |
(regexp-quote root) |
5039 |
";[0-9]+$")) |
";[0-9]+$")) |
5040 |
versions) |
versions) |
5041 |
(ange-ftp-del-hash-entry file files) |
(remhash file files) |
5042 |
;; Now we need to check if there are any |
;; Now we need to check if there are any |
5043 |
;; versions left. If not, then delete the |
;; versions left. If not, then delete the |
5044 |
;; root entry. |
;; root entry. |
5045 |
(mapatoms |
(maphash |
5046 |
(lambda (sym) |
(lambda (key val) |
5047 |
(and (string-match regexp (get sym 'key)) |
(and (string-match regexp key) |
5048 |
(setq versions t))) |
(setq versions t))) |
5049 |
files) |
files) |
5050 |
(or versions |
(or versions |
5051 |
(ange-ftp-del-hash-entry root files)))))))))) |
(remhash root files)))))))))) |
5052 |
|
|
5053 |
(or (assq 'vms ange-ftp-delete-file-entry-alist) |
(or (assq 'vms ange-ftp-delete-file-entry-alist) |
5054 |
(setq ange-ftp-delete-file-entry-alist |
(setq ange-ftp-delete-file-entry-alist |
5058 |
(defun ange-ftp-vms-add-file-entry (name &optional dir-p) |
(defun ange-ftp-vms-add-file-entry (name &optional dir-p) |
5059 |
(if dir-p |
(if dir-p |
5060 |
(ange-ftp-internal-add-file-entry name t) |
(ange-ftp-internal-add-file-entry name t) |
5061 |
(let ((files (ange-ftp-get-hash-entry |
(let ((files (gethash (file-name-directory name) |
5062 |
(file-name-directory name) |
ange-ftp-files-hashtable))) |
|
ange-ftp-files-hashtable))) |
|
5063 |
(if files |
(if files |
5064 |
(let ((file (ange-ftp-get-file-part name))) |
(let ((file (ange-ftp-get-file-part name))) |
5065 |
(save-match-data |
(save-match-data |
5066 |
(if (string-match ";[0-9]+$" file) |
(if (string-match ";[0-9]+$" file) |
5067 |
(ange-ftp-put-hash-entry |
(puthash (substring file 0 (match-beginning 0)) nil files) |
|
(substring file 0 (match-beginning 0)) |
|
|
nil files) |
|
5068 |
;; Need to figure out what version of the file |
;; Need to figure out what version of the file |
5069 |
;; is being added. |
;; is being added. |
5070 |
(let ((regexp (concat "^" |
(let ((regexp (concat "^" |
5071 |
(regexp-quote file) |
(regexp-quote file) |
5072 |
";\\([0-9]+\\)$")) |
";\\([0-9]+\\)$")) |
5073 |
(version 0)) |
(version 0)) |
5074 |
(mapatoms |
(maphash |
5075 |
(lambda (sym) |
(lambda (name val) |
5076 |
(let ((name (get sym 'key))) |
(and (string-match regexp name) |
5077 |
(and (string-match regexp name) |
(setq version |
5078 |
(setq version |
(max version |
5079 |
(max version |
(string-to-int (match-string 1 name)))))) |
|
(string-to-int |
|
|
(substring name |
|
|
(match-beginning 1) |
|
|
(match-end 1)))))))) |
|
5080 |
files) |
files) |
5081 |
(setq version (1+ version)) |
(setq version (1+ version)) |
5082 |
(ange-ftp-put-hash-entry |
(puthash |
5083 |
(concat file ";" (int-to-string version)) |
(concat file ";" (int-to-string version)) |
5084 |
nil files)))) |
nil files)))) |
5085 |
(ange-ftp-put-hash-entry file nil files)))))) |
(puthash file nil files)))))) |
5086 |
|
|
5087 |
(or (assq 'vms ange-ftp-add-file-entry-alist) |
(or (assq 'vms ange-ftp-add-file-entry-alist) |
5088 |
(setq ange-ftp-add-file-entry-alist |
(setq ange-ftp-add-file-entry-alist |
5307 |
;; ;; If the file has numeric backup versions, |
;; ;; If the file has numeric backup versions, |
5308 |
;; ;; put on ange-ftp-file-version-alist an element of the form |
;; ;; put on ange-ftp-file-version-alist an element of the form |
5309 |
;; ;; (FILENAME . VERSION-NUMBER-LIST) |
;; ;; (FILENAME . VERSION-NUMBER-LIST) |
5310 |
;; (dired-map-dired-file-lines (function |
;; (dired-map-dired-file-lines 'ange-ftp-dired-vms-collect-file-versions) |
|
;; ange-ftp-dired-vms-collect-file-versions)) |
|
5311 |
;; ;; Sort each VERSION-NUMBER-LIST, |
;; ;; Sort each VERSION-NUMBER-LIST, |
5312 |
;; ;; and remove the versions not to be deleted. |
;; ;; and remove the versions not to be deleted. |
5313 |
;; (let ((fval ange-ftp-file-version-alist)) |
;; (let ((fval ange-ftp-file-version-alist)) |
5324 |
;; ;; Look at each file. If it is a numeric backup file, |
;; ;; Look at each file. If it is a numeric backup file, |
5325 |
;; ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. |
;; ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. |
5326 |
;; (dired-map-dired-file-lines |
;; (dired-map-dired-file-lines |
5327 |
;; (function |
;; 'ange-ftp-dired-vms-trample-file-versions mark) |
|
;; ange-ftp-dired-vms-trample-file-versions mark)) |
|
5328 |
;; (message (concat action " numerical backups...done")))) |
;; (message (concat action " numerical backups...done")))) |
5329 |
|
|
5330 |
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist) |
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist) |
5426 |
(if reverse |
(if reverse |
5427 |
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) |
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) |
5428 |
(let (acct file) |
(let (acct file) |
5429 |
(if (match-beginning 1) |
(setq acct (match-string 1 name)) |
5430 |
(setq acct (substring name 0 (match-end 1)))) |
(setq file (match-string 2 name)) |
|
(if (match-beginning 2) |
|
|
(setq file (substring name |
|
|
(match-beginning 2) (match-end 2)))) |
|
5431 |
(concat (and acct (concat "/" acct "/")) |
(concat (and acct (concat "/" acct "/")) |
5432 |
file)) |
file)) |
5433 |
(error "name %s didn't match" name)) |
(error "name %s didn't match" name)) |
5434 |
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) |
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) |
5435 |
(concat (substring name 1 (match-end 1)) |
(concat (match-string 1 name) (match-string 2 name)) |
|
(substring name (match-beginning 2) (match-end 2))) |
|
5436 |
;; Let's hope that mts will recognize it anyway. |
;; Let's hope that mts will recognize it anyway. |
5437 |
name)))) |
name)))) |
5438 |
|
|
5473 |
|
|
5474 |
;; Parse the current buffer which is assumed to be in mts ftp dir format. |
;; Parse the current buffer which is assumed to be in mts ftp dir format. |
5475 |
(defun ange-ftp-parse-mts-listing () |
(defun ange-ftp-parse-mts-listing () |
5476 |
(let ((tbl (ange-ftp-make-hashtable))) |
(let ((tbl (make-hash-table :test 'equal))) |
5477 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5478 |
(save-match-data |
(save-match-data |
5479 |
(while (re-search-forward ange-ftp-date-regexp nil t) |
(while (re-search-forward ange-ftp-date-regexp nil t) |
5481 |
(skip-chars-backward " ") |
(skip-chars-backward " ") |
5482 |
(let ((end (point))) |
(let ((end (point))) |
5483 |
(skip-chars-backward "-A-Z0-9_.!") |
(skip-chars-backward "-A-Z0-9_.!") |
5484 |
(ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl)) |
(puthash (buffer-substring (point) end) nil tbl)) |
5485 |
(forward-line 1))) |
(forward-line 1))) |
5486 |
;; Don't need to bother with .. |
;; Don't need to bother with .. |
5487 |
(ange-ftp-put-hash-entry "." t tbl) |
(puthash "." t tbl) |
5488 |
tbl)) |
tbl)) |
5489 |
|
|
5490 |
(or (assq 'mts ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5491 |
(setq ange-ftp-parse-list-func-alist |
'(mts . ange-ftp-parse-mts-listing)) |
|
(cons '(mts . ange-ftp-parse-mts-listing) |
|
|
ange-ftp-parse-list-func-alist))) |
|
5492 |
|
|
5493 |
(defun ange-ftp-add-mts-host (host) |
(defun ange-ftp-add-mts-host (host) |
5494 |
"Mark HOST as the name of a machine running MTS." |
"Mark HOST as the name of a machine running MTS." |
5589 |
(concat "/" name) |
(concat "/" name) |
5590 |
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" |
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" |
5591 |
name) |
name) |
5592 |
(let ((minidisk (substring name 1 (match-end 1)))) |
(let ((minidisk (match-string 1 name))) |
5593 |
(if (match-beginning 2) |
(if (match-beginning 2) |
5594 |
(let ((file (substring name (match-beginning 2) |
(let ((file (match-string 2 name)) |
|
(match-end 2))) |
|
5595 |
(cmd (concat "cd " minidisk)) |
(cmd (concat "cd " minidisk)) |
5596 |
|
|
5597 |
;; Note that host and user are bound in the call |
;; Note that host and user are bound in the call |
5633 |
((string-equal "/" dir-name) |
((string-equal "/" dir-name) |
5634 |
(error "Cannot get listing for fictitious \"/\" directory")) |
(error "Cannot get listing for fictitious \"/\" directory")) |
5635 |
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) |
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) |
5636 |
(let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1))) |
(let* ((minidisk (match-string 1 dir-name)) |
5637 |
;; host and user are bound in the call to ange-ftp-send-cmd |
;; host and user are bound in the call to ange-ftp-send-cmd |
5638 |
(proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) |
(proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) |
5639 |
(cmd (concat "cd " minidisk)) |
(cmd (concat "cd " minidisk)) |
5640 |
(file (if (match-beginning 2) |
(file (if (match-beginning 2) |
5641 |
;; it's a single file |
;; it's a single file |
5642 |
(substring dir-name (match-beginning 2) |
(match-string 2 dir-name) |
|
(match-end 2)) |
|
5643 |
;; use the wild-card |
;; use the wild-card |
5644 |
"*"))) |
"*"))) |
5645 |
(if (car (ange-ftp-raw-send-cmd proc cmd)) |
(if (car (ange-ftp-raw-send-cmd proc cmd)) |
5696 |
; (minidisk (ange-ftp-get-file-part dir-file)) |
; (minidisk (ange-ftp-get-file-part dir-file)) |
5697 |
; (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable))) |
; (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable))) |
5698 |
; (if root-tbl |
; (if root-tbl |
5699 |
; (ange-ftp-put-hash-entry minidisk t root-tbl) |
; (puthash minidisk t root-tbl) |
5700 |
; (setq root-tbl (ange-ftp-make-hashtable)) |
; (setq root-tbl (ange-ftp-make-hashtable)) |
5701 |
; (ange-ftp-put-hash-entry minidisk t root-tbl) |
; (puthash minidisk t root-tbl) |
5702 |
; (ange-ftp-put-hash-entry "." t root-tbl) |
; (puthash "." t root-tbl) |
5703 |
; (ange-ftp-set-files root root-tbl))) |
; (ange-ftp-set-files root root-tbl))) |
5704 |
;; Now do the usual parsing |
;; Now do the usual parsing |
5705 |
(let ((tbl (ange-ftp-make-hashtable))) |
(let ((tbl (make-hash-table :test 'equal))) |
5706 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5707 |
(save-match-data |
(save-match-data |
5708 |
(while |
(while |
5709 |
(re-search-forward |
(re-search-forward |
5710 |
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t) |
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t) |
5711 |
(ange-ftp-put-hash-entry |
(puthash (concat (match-string 1) "." (match-string 2)) nil tbl) |
|
(concat (buffer-substring (match-beginning 1) |
|
|
(match-end 1)) |
|
|
"." |
|
|
(buffer-substring (match-beginning 2) |
|
|
(match-end 2))) |
|
|
nil tbl) |
|
5712 |
(forward-line 1)) |
(forward-line 1)) |
5713 |
(ange-ftp-put-hash-entry "." t tbl)) |
(puthash "." t tbl)) |
5714 |
tbl)) |
tbl)) |
5715 |
|
|
5716 |
(or (assq 'cms ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5717 |
(setq ange-ftp-parse-list-func-alist |
'(cms . ange-ftp-parse-cms-listing)) |
|
(cons '(cms . ange-ftp-parse-cms-listing) |
|
|
ange-ftp-parse-list-func-alist))) |
|
5718 |
|
|
5719 |
;;;;; Tree dired support: |
;;;;; Tree dired support: |
5720 |
|
|
5828 |
"^\\(" ange-ftp-bs2000-filename-pubset-regexp "\\)?" |
"^\\(" ange-ftp-bs2000-filename-pubset-regexp "\\)?" |
5829 |
"\\(" ange-ftp-bs2000-filename-username-regexp "\\)?" |
"\\(" ange-ftp-bs2000-filename-username-regexp "\\)?" |
5830 |
"\\(" ange-ftp-bs2000-short-filename-regexp "\\)?") |
"\\(" ange-ftp-bs2000-short-filename-regexp "\\)?") |
5831 |
"Regular expression used in ange-ftp-fix-name-for-bs2000.") |
"Regular expression used in ange-ftp-fix-name-for-bs2000.") |
5832 |
|
|
5833 |
(defconst ange-ftp-bs2000-fix-name-regexp |
(defconst ange-ftp-bs2000-fix-name-regexp |
5834 |
(concat |
(concat |
5835 |
"/?\\(" ange-ftp-bs2000-filename-pubset-regexp "/\\)?" |
"/?\\(" ange-ftp-bs2000-filename-pubset-regexp "/\\)?" |
5836 |
"\\(\\$[A-Z0-9]*/\\)?" |
"\\(\\$[A-Z0-9]*/\\)?" |
5837 |
"\\(" ange-ftp-bs2000-short-filename-regexp "\\)?") |
"\\(" ange-ftp-bs2000-short-filename-regexp "\\)?") |
5838 |
"Regular expression used in ange-ftp-fix-name-for-bs2000.") |
"Regular expression used in ange-ftp-fix-name-for-bs2000.") |
5839 |
|
|
5840 |
(defcustom ange-ftp-bs2000-special-prefix |
(defcustom ange-ftp-bs2000-special-prefix |
5841 |
"X" |
"X" |
5895 |
(and userid (concat userid ".")) |
(and userid (concat userid ".")) |
5896 |
;; change every '/' in filename to a '.', normally not neccessary |
;; change every '/' in filename to a '.', normally not neccessary |
5897 |
(and filename |
(and filename |
5898 |
(apply (function concat) |
(subst-char-in-string ?/ ?. filename))))) |
|
(mapcar (function (lambda (char) |
|
|
(if (= char ?/) |
|
|
(vector ?.) |
|
|
(vector char)))) |
|
|
filename)))))) |
|
5899 |
;; Let's hope that BS2000 recognize this anyway: |
;; Let's hope that BS2000 recognize this anyway: |
5900 |
name)))) |
name)))) |
5901 |
|
|
5947 |
ange-ftp-bs2000-host-regexp) |
ange-ftp-bs2000-host-regexp) |
5948 |
ange-ftp-host-cache nil))) |
ange-ftp-host-cache nil))) |
5949 |
|
|
|
(defvar ange-ftp-bs2000-posix-hook-installed nil) |
|
|
|
|
5950 |
(defun ange-ftp-add-bs2000-posix-host (host) |
(defun ange-ftp-add-bs2000-posix-host (host) |
5951 |
"Mark HOST as the name of a machine running BS2000 with POSIX subsystem." |
"Mark HOST as the name of a machine running BS2000 with POSIX subsystem." |
5952 |
(interactive |
(interactive |
5960 |
ange-ftp-bs2000-posix-host-regexp) |
ange-ftp-bs2000-posix-host-regexp) |
5961 |
ange-ftp-host-cache nil)) |
ange-ftp-host-cache nil)) |
5962 |
;; Install CD hook to cd to posix on connecting: |
;; Install CD hook to cd to posix on connecting: |
5963 |
(and (not ange-ftp-bs2000-posix-hook-installed) |
(add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix) |
|
(add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix) |
|
|
(setq ange-ftp-bs2000-posix-hook-installed t)) |
|
5964 |
host) |
host) |
5965 |
|
|
5966 |
(defconst ange-ftp-bs2000-filename-regexp |
(defconst ange-ftp-bs2000-filename-regexp |
5982 |
;; Extract the next filename from a BS2000 dired-like listing. |
;; Extract the next filename from a BS2000 dired-like listing. |
5983 |
(defun ange-ftp-parse-bs2000-filename () |
(defun ange-ftp-parse-bs2000-filename () |
5984 |
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t) |
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t) |
5985 |
(buffer-substring (match-beginning 2) (match-end 2)))) |
(match-string 2))) |
5986 |
|
|
5987 |
;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir |
;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir |
5988 |
;; format, and return a hashtable as the result. |
;; format, and return a hashtable as the result. |
5989 |
(defun ange-ftp-parse-bs2000-listing () |
(defun ange-ftp-parse-bs2000-listing () |
5990 |
(let ((tbl (ange-ftp-make-hashtable)) |
(let ((tbl (make-hash-table :test 'equal)) |
5991 |
pubset |
pubset |
5992 |
file) |
file) |
5993 |
;; get current pubset |
;; get current pubset |
5994 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5995 |
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t) |
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t) |
5996 |
(setq pubset (buffer-substring (match-beginning 0) (match-end 0)))) |
(setq pubset (match-string 0))) |
5997 |
;; add files to hashtable |
;; add files to hashtable |
5998 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5999 |
(save-match-data |
(save-match-data |
6000 |
(while (setq file (ange-ftp-parse-bs2000-filename)) |
(while (setq file (ange-ftp-parse-bs2000-filename)) |
6001 |
(ange-ftp-put-hash-entry file nil tbl))) |
(puthash file nil tbl))) |
6002 |
;; add . and .. |
;; add . and .. |
6003 |
(ange-ftp-put-hash-entry "." t tbl) |
(puthash "." t tbl) |
6004 |
(ange-ftp-put-hash-entry ".." t tbl) |
(puthash ".." t tbl) |
6005 |
;; add all additional pubsets, if not listing one of them |
;; add all additional pubsets, if not listing one of them |
6006 |
(if (not (member pubset ange-ftp-bs2000-additional-pubsets)) |
(if (not (member pubset ange-ftp-bs2000-additional-pubsets)) |
6007 |
(mapcar (function (lambda (pubset) |
(mapcar (lambda (pubset) (puthash pubset t tbl)) |
|
(ange-ftp-put-hash-entry pubset t tbl))) |
|
6008 |
ange-ftp-bs2000-additional-pubsets)) |
ange-ftp-bs2000-additional-pubsets)) |
6009 |
tbl)) |
tbl)) |
6010 |
|
|
6011 |
(or (assq 'bs2000 ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
6012 |
(setq ange-ftp-parse-list-func-alist |
'(bs2000 . ange-ftp-parse-bs2000-listing)) |
|
(cons '(bs2000 . ange-ftp-parse-bs2000-listing) |
|
|
ange-ftp-parse-list-func-alist))) |
|
6013 |
|
|
6014 |
(defun ange-ftp-bs2000-cd-to-posix () |
(defun ange-ftp-bs2000-cd-to-posix () |
6015 |
"cd to POSIX subsystem if the current host matches |
"cd to POSIX subsystem if the current host matches |
6016 |
ange-ftp-bs2000-posix-host-regexp. All BS2000 hosts with POSIX subsystem |
`ange-ftp-bs2000-posix-host-regexp'. All BS2000 hosts with POSIX subsystem |
6017 |
MUST BE EXPLICITLY SET with ange-ftp-add-bs2000-posix-host for they cannot |
MUST BE EXPLICITLY SET with `ange-ftp-add-bs2000-posix-host' for they cannot |
6018 |
be recognized automatically (they are all valid BS2000 hosts too)." |
be recognized automatically (they are all valid BS2000 hosts too)." |
6019 |
(if (and host (ange-ftp-bs2000-posix-host host)) |
(if (and ange-ftp-this-host (ange-ftp-bs2000-posix-host ange-ftp-this-host)) |
6020 |
(progn |
(progn |
6021 |
;; change to POSIX: |
;; change to POSIX: |
6022 |
; (ange-ftp-raw-send-cmd proc "cd %POSIX") |
; (ange-ftp-raw-send-cmd proc "cd %POSIX") |
6023 |
(ange-ftp-cd host user "%POSIX") |
(ange-ftp-cd ange-ftp-this-host ange-ftp-this-user "%POSIX") |
6024 |
;; put new home directory in the expand-dir hashtable. |
;; put new home directory in the expand-dir hashtable. |
6025 |
;; `host' and `user' are bound in ange-ftp-get-process. |
;; `ange-ftp-this-host' and `ange-ftp-this-user' are bound in |
6026 |
(ange-ftp-put-hash-entry (concat host "/" user "/~") |
;; ange-ftp-get-process. |
6027 |
(car (ange-ftp-get-pwd host user)) |
(puthash (concat ange-ftp-this-host "/" ange-ftp-this-user "/~") |
6028 |
ange-ftp-expand-dir-hashtable)))) |
(car (ange-ftp-get-pwd ange-ftp-this-host ange-ftp-this-user)) |
6029 |
|
ange-ftp-expand-dir-hashtable)))) |
6030 |
|
|
6031 |
;; Not available yet: |
;; Not available yet: |
6032 |
;; ange-ftp-bs2000-delete-file-entry |
;; ange-ftp-bs2000-delete-file-entry |