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) |
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 |
|
|
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) |
2693 |
;; unquoting names obtained with the SysV b switch and the GNU Q |
;; unquoting names obtained with the SysV b switch and the GNU Q |
2694 |
;; switch. See Sebastian's dired-get-filename. |
;; switch. See Sebastian's dired-get-filename. |
2695 |
|
|
2696 |
(defun ange-ftp-ls-parser () |
(defun ange-ftp-ls-parser (switches) |
|
;; Note that switches is dynamically bound. |
|
2697 |
;; Meant to be called by ange-ftp-parse-dired-listing |
;; Meant to be called by ange-ftp-parse-dired-listing |
2698 |
(let ((tbl (make-hash-table :test 'equal)) |
(let ((tbl (make-hash-table :test 'equal)) |
2699 |
(used-F (and (stringp switches) |
(used-F (and (stringp switches) |
2724 |
(and (not symlink) ; x bits don't mean a thing for symlinks |
(and (not symlink) ; x bits don't mean a thing for symlinks |
2725 |
(string-match |
(string-match |
2726 |
"[xst]" |
"[xst]" |
2727 |
(concat (buffer-substring |
(concat (match-string 1) |
2728 |
(match-beginning 1) (match-end 1)) |
(match-string 2) |
2729 |
(buffer-substring |
(match-string 3)))))) |
|
(match-beginning 2) (match-end 2)) |
|
|
(buffer-substring |
|
|
(match-beginning 3) (match-end 3))))))) |
|
2730 |
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) |
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) |
2731 |
;; and others don't. (sigh...) Beware, that some Unix's don't |
;; and others don't. (sigh...) Beware, that some Unix's don't |
2732 |
;; seem to believe in the F-switch |
;; seem to believe in the F-switch |
2790 |
(forward-line 1) |
(forward-line 1) |
2791 |
;; Some systems put in a blank line here. |
;; Some systems put in a blank line here. |
2792 |
(if (eolp) (forward-line 1)) |
(if (eolp) (forward-line 1)) |
2793 |
(ange-ftp-ls-parser)) |
(ange-ftp-ls-parser switches)) |
2794 |
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") |
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") |
2795 |
;; It's an ls error message. |
;; It's an ls error message. |
2796 |
nil) |
nil) |
2804 |
nil) |
nil) |
2805 |
((re-search-forward ange-ftp-date-regexp nil t) |
((re-search-forward ange-ftp-date-regexp nil t) |
2806 |
(beginning-of-line) |
(beginning-of-line) |
2807 |
(ange-ftp-ls-parser)) |
(ange-ftp-ls-parser switches)) |
2808 |
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t) |
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t) |
2809 |
;; It's a dl listing (I hope). |
;; It's a dl listing (I hope). |
2810 |
;; file is bound by the call to ange-ftp-ls |
;; file is bound by the call to ange-ftp-ls |
2861 |
(defmacro ange-ftp-get-file-part (name) |
(defmacro ange-ftp-get-file-part (name) |
2862 |
`(let ((file (file-name-nondirectory ,name))) |
`(let ((file (file-name-nondirectory ,name))) |
2863 |
(if (string-equal file "") |
(if (string-equal file "") |
2864 |
"." |
"." |
2865 |
file))) |
file))) |
2866 |
|
|
2867 |
;; 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 |
2872 |
;; 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 |
2873 |
;; subdirectory. This is of course an OS dependent judgement. |
;; subdirectory. This is of course an OS dependent judgement. |
2874 |
|
|
2875 |
|
(defvar dired-local-variables-file) |
2876 |
(defmacro ange-ftp-allow-child-lookup (dir file) |
(defmacro ange-ftp-allow-child-lookup (dir file) |
2877 |
`(not |
`(not |
2878 |
(let* ((efile ,file) ; expand once. |
(let* ((efile ,file) ; expand once. |
3015 |
(if (car result) |
(if (car result) |
3016 |
(save-match-data |
(save-match-data |
3017 |
(and (or (string-match "\"\\([^\"]*\\)\"" line) |
(and (or (string-match "\"\\([^\"]*\\)\"" line) |
3018 |
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! |
(string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! |
3019 |
(setq dir (substring line |
(setq dir (match-string 1 line))))) |
|
(match-beginning 1) |
|
|
(match-end 1)))))) |
|
3020 |
(cons dir line))) |
(cons dir line))) |
3021 |
|
|
3022 |
;;; ------------------------------------------------------------ |
;;; ------------------------------------------------------------ |
3050 |
(line (cdr result))) |
(line (cdr result))) |
3051 |
(setq res |
(setq res |
3052 |
(if (string-match ange-ftp-expand-dir-regexp line) |
(if (string-match ange-ftp-expand-dir-regexp line) |
3053 |
(substring line |
(match-string 1 line))))) |
|
(match-beginning 1) |
|
|
(match-end 1)))))) |
|
3054 |
(or res |
(or res |
3055 |
(if (string-equal dir "~") |
(if (string-equal dir "~") |
3056 |
(setq res (car (ange-ftp-get-pwd host user))) |
(setq res (car (ange-ftp-get-pwd host user))) |
3085 |
;; Name starts with ~ or ~user. Resolve that part of the name |
;; Name starts with ~ or ~user. Resolve that part of the name |
3086 |
;; making it absolute then re-expand it. |
;; making it absolute then re-expand it. |
3087 |
((string-match "^~[^/]*" name) |
((string-match "^~[^/]*" name) |
3088 |
(let* ((tilda (substring name |
(let* ((tilda (match-string 0 name)) |
|
(match-beginning 0) |
|
|
(match-end 0))) |
|
3089 |
(rest (substring name (match-end 0))) |
(rest (substring name (match-end 0))) |
3090 |
(dir (ange-ftp-expand-dir host user tilda))) |
(dir (ange-ftp-expand-dir host user tilda))) |
3091 |
(if dir |
(if dir |
3197 |
(let ((parsed (ange-ftp-ftp-name dir))) |
(let ((parsed (ange-ftp-ftp-name dir))) |
3198 |
(if parsed |
(if parsed |
3199 |
(ange-ftp-replace-name-component |
(ange-ftp-replace-name-component |
3200 |
dir |
dir |
3201 |
(ange-ftp-real-directory-file-name (nth 2 parsed))) |
(ange-ftp-real-directory-file-name (nth 2 parsed))) |
3202 |
(ange-ftp-real-directory-file-name dir)))) |
(ange-ftp-real-directory-file-name dir)))) |
3203 |
|
|
3204 |
|
|
3580 |
;; filename |
;; filename |
3581 |
;; newname)) |
;; newname)) |
3582 |
;; res) |
;; res) |
3583 |
;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel)) |
;; (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel) |
3584 |
;; (process-kill-without-query proc) |
;; (process-kill-without-query proc) |
3585 |
;; (with-current-buffer (process-buffer proc) |
;; (with-current-buffer (process-buffer proc) |
3586 |
;; (set (make-local-variable 'copy-cont) cont)))) |
;; (set (make-local-variable 'copy-cont) cont)))) |
3668 |
(if (and temp1 t-parsed) |
(if (and temp1 t-parsed) |
3669 |
(format "Getting %s" f-abbr) |
(format "Getting %s" f-abbr) |
3670 |
(format "Copying %s to %s" f-abbr t-abbr))) |
(format "Copying %s to %s" f-abbr t-abbr))) |
3671 |
(list (function ange-ftp-cf1) |
(list 'ange-ftp-cf1 |
3672 |
filename newname binary msg |
filename newname binary msg |
3673 |
f-parsed f-host f-user f-name f-abbr |
f-parsed f-host f-user f-name f-abbr |
3674 |
t-parsed t-host t-user t-name t-abbr |
t-parsed t-host t-user t-name t-abbr |
3746 |
(if (and temp2 f-parsed) |
(if (and temp2 f-parsed) |
3747 |
(format "Putting %s" newname) |
(format "Putting %s" newname) |
3748 |
(format "Copying %s to %s" f-abbr t-abbr))) |
(format "Copying %s to %s" f-abbr t-abbr))) |
3749 |
(list (function ange-ftp-cf2) |
(list 'ange-ftp-cf2 |
3750 |
newname t-host t-user binary temp1 temp2 cont) |
newname t-host t-user binary temp1 temp2 cont) |
3751 |
nowait)) |
nowait)) |
3752 |
|
|
3901 |
;;;; File name completion support. |
;;;; File name completion support. |
3902 |
;;;; ------------------------------------------------------------ |
;;;; ------------------------------------------------------------ |
3903 |
|
|
|
;; 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 (key val) |
|
|
(or (not (stringp val)) |
|
|
(file-exists-p (ange-ftp-expand-symlink val ange-ftp-this-dir)))) |
|
|
|
|
3904 |
;; 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) |
3905 |
;; 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 |
3906 |
;; by completion-ignored-extensions. |
;; by completion-ignored-extensions. |
3931 |
(setq ange-ftp-this-dir |
(setq ange-ftp-this-dir |
3932 |
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) |
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) |
3933 |
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) |
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) |
3934 |
(completions |
(completions (all-completions file tbl))) |
|
(all-completions file tbl |
|
|
(function ange-ftp-file-entry-active-p)))) |
|
3935 |
|
|
3936 |
;; see whether each matching file is a directory or not... |
;; see whether each matching file is a directory or not... |
3937 |
(mapcar |
(mapcar |
3971 |
(save-match-data |
(save-match-data |
3972 |
(or (ange-ftp-file-name-completion-1 |
(or (ange-ftp-file-name-completion-1 |
3973 |
file tbl ange-ftp-this-dir |
file tbl ange-ftp-this-dir |
3974 |
(function ange-ftp-file-entry-not-ignored-p)) |
'ange-ftp-file-entry-not-ignored-p) |
3975 |
(ange-ftp-file-name-completion-1 |
(ange-ftp-file-name-completion-1 |
3976 |
file tbl ange-ftp-this-dir |
file tbl ange-ftp-this-dir)))))) |
|
(function ange-ftp-file-entry-active-p))))))) |
|
3977 |
|
|
3978 |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
(if (ange-ftp-root-dir-p ange-ftp-this-dir) |
3979 |
(try-completion |
(try-completion |
3984 |
(ange-ftp-real-file-name-completion file ange-ftp-this-dir))))) |
(ange-ftp-real-file-name-completion file ange-ftp-this-dir))))) |
3985 |
|
|
3986 |
|
|
3987 |
(defun ange-ftp-file-name-completion-1 (file tbl dir predicate) |
(defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate) |
3988 |
(let ((bestmatch (try-completion file tbl predicate))) |
(let ((bestmatch (try-completion file tbl predicate))) |
3989 |
(if bestmatch |
(if bestmatch |
3990 |
(if (eq bestmatch t) |
(if (eq bestmatch t) |
4077 |
(nth 2 parsed)) |
(nth 2 parsed)) |
4078 |
(ange-ftp-real-file-name-as-directory |
(ange-ftp-real-file-name-as-directory |
4079 |
(nth 2 parsed))))) |
(nth 2 parsed))))) |
4080 |
(abbr (ange-ftp-abbreviate-filename dir)) |
(abbr (ange-ftp-abbreviate-filename dir)) |
4081 |
(result (ange-ftp-send-cmd host user |
(result (ange-ftp-send-cmd host user |
4082 |
(list 'rmdir name) |
(list 'rmdir name) |
4083 |
(format "Removing directory %s" |
(format "Removing directory %s" |
4084 |
abbr)))) |
abbr)))) |
4085 |
(or (car result) |
(or (car result) |
4086 |
(ange-ftp-error host user |
(ange-ftp-error host user |
4087 |
(format "Could not remove directory %s: %s" |
(format "Could not remove directory %s: %s" |
4490 |
;; ((equal dired-chown-program program)) |
;; ((equal dired-chown-program program)) |
4491 |
(t (error "Unknown remote command: %s" program))) |
(t (error "Unknown remote command: %s" program))) |
4492 |
(ftp-error (insert (format "%s: %s, %s\n" |
(ftp-error (insert (format "%s: %s, %s\n" |
4493 |
(nth 1 oops) |
(nth 1 oops) |
4494 |
(nth 2 oops) |
(nth 2 oops) |
4495 |
(nth 3 oops))) |
(nth 3 oops))) |
4496 |
;; Caller expects nonzero value to mean failure. |
;; Caller expects nonzero value to mean failure. |
4497 |
1) |
1) |
4498 |
(error (insert (format "%s\n" (nth 1 oops))) |
(error (insert (format "%s\n" (nth 1 oops))) |
4643 |
;; (t nil)))) |
;; (t nil)))) |
4644 |
;; (condition-case err |
;; (condition-case err |
4645 |
;; (funcall file-creator from to overwrite-confirmed |
;; (funcall file-creator from to overwrite-confirmed |
4646 |
;; (list (function ange-ftp-dcf-2) |
;; (list 'ange-ftp-dcf-2 |
4647 |
;; nil ;err |
;; nil ;err |
4648 |
;; file-creator operation fn-list |
;; file-creator operation fn-list |
4649 |
;; name-constructor |
;; name-constructor |
4889 |
(if reverse |
(if reverse |
4890 |
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) |
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) |
4891 |
(let (drive dir file) |
(let (drive dir file) |
4892 |
(if (match-beginning 1) |
(setq drive (match-string 1 name)) |
4893 |
(setq drive (substring name |
(setq dir (match-string 2 name)) |
4894 |
(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)))) |
|
4895 |
(and dir |
(and dir |
4896 |
(setq dir (subst-char-in-string |
(setq dir (subst-char-in-string |
4897 |
?/ ?. (substring dir 1 -1) t))) |
?/ ?. (substring dir 1 -1) t))) |
4977 |
;; Extract the next filename from a VMS dired-like listing. |
;; Extract the next filename from a VMS dired-like listing. |
4978 |
(defun ange-ftp-parse-vms-filename () |
(defun ange-ftp-parse-vms-filename () |
4979 |
(if (re-search-forward |
(if (re-search-forward |
4980 |
ange-ftp-vms-filename-regexp |
ange-ftp-vms-filename-regexp |
4981 |
nil t) |
nil t) |
4982 |
(buffer-substring (match-beginning 0) (match-end 0)))) |
(match-string 0))) |
4983 |
|
|
4984 |
;; 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 |
4985 |
;; format, and return a hashtable as the result. |
;; format, and return a hashtable as the result. |
5005 |
(puthash ".." t tbl)) |
(puthash ".." t tbl)) |
5006 |
tbl)) |
tbl)) |
5007 |
|
|
5008 |
(or (assq 'vms ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5009 |
(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))) |
|
5010 |
|
|
5011 |
;; This version only deletes file entries which have |
;; This version only deletes file entries which have |
5012 |
;; explicit version numbers, because that is all VMS allows. |
;; explicit version numbers, because that is all VMS allows. |
5070 |
(and (string-match regexp name) |
(and (string-match regexp name) |
5071 |
(setq version |
(setq version |
5072 |
(max version |
(max version |
5073 |
(string-to-int |
(string-to-int (match-string 1 name)))))) |
|
(substring name |
|
|
(match-beginning 1) |
|
|
(match-end 1))))))) |
|
5074 |
files) |
files) |
5075 |
(setq version (1+ version)) |
(setq version (1+ version)) |
5076 |
(puthash |
(puthash |
5301 |
;; ;; If the file has numeric backup versions, |
;; ;; If the file has numeric backup versions, |
5302 |
;; ;; put on ange-ftp-file-version-alist an element of the form |
;; ;; put on ange-ftp-file-version-alist an element of the form |
5303 |
;; ;; (FILENAME . VERSION-NUMBER-LIST) |
;; ;; (FILENAME . VERSION-NUMBER-LIST) |
5304 |
;; (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)) |
|
5305 |
;; ;; Sort each VERSION-NUMBER-LIST, |
;; ;; Sort each VERSION-NUMBER-LIST, |
5306 |
;; ;; and remove the versions not to be deleted. |
;; ;; and remove the versions not to be deleted. |
5307 |
;; (let ((fval ange-ftp-file-version-alist)) |
;; (let ((fval ange-ftp-file-version-alist)) |
5318 |
;; ;; Look at each file. If it is a numeric backup file, |
;; ;; Look at each file. If it is a numeric backup file, |
5319 |
;; ;; 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. |
5320 |
;; (dired-map-dired-file-lines |
;; (dired-map-dired-file-lines |
5321 |
;; (function |
;; 'ange-ftp-dired-vms-trample-file-versions mark) |
|
;; ange-ftp-dired-vms-trample-file-versions mark)) |
|
5322 |
;; (message (concat action " numerical backups...done")))) |
;; (message (concat action " numerical backups...done")))) |
5323 |
|
|
5324 |
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist) |
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist) |
5420 |
(if reverse |
(if reverse |
5421 |
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) |
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) |
5422 |
(let (acct file) |
(let (acct file) |
5423 |
(if (match-beginning 1) |
(setq acct (match-string 1 name)) |
5424 |
(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)))) |
|
5425 |
(concat (and acct (concat "/" acct "/")) |
(concat (and acct (concat "/" acct "/")) |
5426 |
file)) |
file)) |
5427 |
(error "name %s didn't match" name)) |
(error "name %s didn't match" name)) |
5428 |
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) |
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) |
5429 |
(concat (substring name 1 (match-end 1)) |
(concat (match-string 1 name) (match-string 2 name)) |
|
(substring name (match-beginning 2) (match-end 2))) |
|
5430 |
;; Let's hope that mts will recognize it anyway. |
;; Let's hope that mts will recognize it anyway. |
5431 |
name)))) |
name)))) |
5432 |
|
|
5481 |
(puthash "." t tbl) |
(puthash "." t tbl) |
5482 |
tbl)) |
tbl)) |
5483 |
|
|
5484 |
(or (assq 'mts ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5485 |
(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))) |
|
5486 |
|
|
5487 |
(defun ange-ftp-add-mts-host (host) |
(defun ange-ftp-add-mts-host (host) |
5488 |
"Mark HOST as the name of a machine running MTS." |
"Mark HOST as the name of a machine running MTS." |
5583 |
(concat "/" name) |
(concat "/" name) |
5584 |
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" |
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" |
5585 |
name) |
name) |
5586 |
(let ((minidisk (substring name 1 (match-end 1)))) |
(let ((minidisk (match-string 1 name))) |
5587 |
(if (match-beginning 2) |
(if (match-beginning 2) |
5588 |
(let ((file (substring name (match-beginning 2) |
(let ((file (match-string 2 name)) |
|
(match-end 2))) |
|
5589 |
(cmd (concat "cd " minidisk)) |
(cmd (concat "cd " minidisk)) |
5590 |
|
|
5591 |
;; Note that host and user are bound in the call |
;; Note that host and user are bound in the call |
5627 |
((string-equal "/" dir-name) |
((string-equal "/" dir-name) |
5628 |
(error "Cannot get listing for fictitious \"/\" directory")) |
(error "Cannot get listing for fictitious \"/\" directory")) |
5629 |
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) |
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) |
5630 |
(let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1))) |
(let* ((minidisk (match-string 1 dir-name)) |
5631 |
;; 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 |
5632 |
(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)) |
5633 |
(cmd (concat "cd " minidisk)) |
(cmd (concat "cd " minidisk)) |
5634 |
(file (if (match-beginning 2) |
(file (if (match-beginning 2) |
5635 |
;; it's a single file |
;; it's a single file |
5636 |
(substring dir-name (match-beginning 2) |
(match-string 2 dir-name) |
|
(match-end 2)) |
|
5637 |
;; use the wild-card |
;; use the wild-card |
5638 |
"*"))) |
"*"))) |
5639 |
(if (car (ange-ftp-raw-send-cmd proc cmd)) |
(if (car (ange-ftp-raw-send-cmd proc cmd)) |
5702 |
(while |
(while |
5703 |
(re-search-forward |
(re-search-forward |
5704 |
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t) |
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t) |
5705 |
(puthash |
(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) |
|
5706 |
(forward-line 1)) |
(forward-line 1)) |
5707 |
(puthash "." t tbl)) |
(puthash "." t tbl)) |
5708 |
tbl)) |
tbl)) |
5709 |
|
|
5710 |
(or (assq 'cms ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
5711 |
(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))) |
|
5712 |
|
|
5713 |
;;;;; Tree dired support: |
;;;;; Tree dired support: |
5714 |
|
|
5889 |
(and userid (concat userid ".")) |
(and userid (concat userid ".")) |
5890 |
;; change every '/' in filename to a '.', normally not neccessary |
;; change every '/' in filename to a '.', normally not neccessary |
5891 |
(and filename |
(and filename |
5892 |
(apply (function concat) |
(subst-char-in-string ?/ ?. filename))))) |
|
(mapcar (function (lambda (char) |
|
|
(if (= char ?/) |
|
|
(vector ?.) |
|
|
(vector char)))) |
|
|
filename)))))) |
|
5893 |
;; Let's hope that BS2000 recognize this anyway: |
;; Let's hope that BS2000 recognize this anyway: |
5894 |
name)))) |
name)))) |
5895 |
|
|
5941 |
ange-ftp-bs2000-host-regexp) |
ange-ftp-bs2000-host-regexp) |
5942 |
ange-ftp-host-cache nil))) |
ange-ftp-host-cache nil))) |
5943 |
|
|
|
(defvar ange-ftp-bs2000-posix-hook-installed nil) |
|
|
|
|
5944 |
(defun ange-ftp-add-bs2000-posix-host (host) |
(defun ange-ftp-add-bs2000-posix-host (host) |
5945 |
"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." |
5946 |
(interactive |
(interactive |
5954 |
ange-ftp-bs2000-posix-host-regexp) |
ange-ftp-bs2000-posix-host-regexp) |
5955 |
ange-ftp-host-cache nil)) |
ange-ftp-host-cache nil)) |
5956 |
;; Install CD hook to cd to posix on connecting: |
;; Install CD hook to cd to posix on connecting: |
5957 |
(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)) |
|
5958 |
host) |
host) |
5959 |
|
|
5960 |
(defconst ange-ftp-bs2000-filename-regexp |
(defconst ange-ftp-bs2000-filename-regexp |
5976 |
;; Extract the next filename from a BS2000 dired-like listing. |
;; Extract the next filename from a BS2000 dired-like listing. |
5977 |
(defun ange-ftp-parse-bs2000-filename () |
(defun ange-ftp-parse-bs2000-filename () |
5978 |
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t) |
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t) |
5979 |
(buffer-substring (match-beginning 2) (match-end 2)))) |
(match-string 2))) |
5980 |
|
|
5981 |
;; 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 |
5982 |
;; format, and return a hashtable as the result. |
;; format, and return a hashtable as the result. |
5987 |
;; get current pubset |
;; get current pubset |
5988 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5989 |
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t) |
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t) |
5990 |
(setq pubset (buffer-substring (match-beginning 0) (match-end 0)))) |
(setq pubset (match-string 0))) |
5991 |
;; add files to hashtable |
;; add files to hashtable |
5992 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5993 |
(save-match-data |
(save-match-data |
6002 |
ange-ftp-bs2000-additional-pubsets)) |
ange-ftp-bs2000-additional-pubsets)) |
6003 |
tbl)) |
tbl)) |
6004 |
|
|
6005 |
(or (assq 'bs2000 ange-ftp-parse-list-func-alist) |
(add-to-list 'ange-ftp-parse-list-func-alist |
6006 |
(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))) |
|
6007 |
|
|
6008 |
(defun ange-ftp-bs2000-cd-to-posix () |
(defun ange-ftp-bs2000-cd-to-posix () |
6009 |
"cd to POSIX subsystem if the current host matches |
"cd to POSIX subsystem if the current host matches |
6010 |
ange-ftp-bs2000-posix-host-regexp. All BS2000 hosts with POSIX subsystem |
`ange-ftp-bs2000-posix-host-regexp'. All BS2000 hosts with POSIX subsystem |
6011 |
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 |
6012 |
be recognized automatically (they are all valid BS2000 hosts too)." |
be recognized automatically (they are all valid BS2000 hosts too)." |
6013 |
(if (and host (ange-ftp-bs2000-posix-host host)) |
(if (and ange-ftp-this-host (ange-ftp-bs2000-posix-host ange-ftp-this-host)) |
6014 |
(progn |
(progn |
6015 |
;; change to POSIX: |
;; change to POSIX: |
6016 |
; (ange-ftp-raw-send-cmd proc "cd %POSIX") |
; (ange-ftp-raw-send-cmd proc "cd %POSIX") |
6017 |
(ange-ftp-cd host user "%POSIX") |
(ange-ftp-cd ange-ftp-this-host ange-ftp-this-user "%POSIX") |
6018 |
;; put new home directory in the expand-dir hashtable. |
;; put new home directory in the expand-dir hashtable. |
6019 |
;; `host' and `user' are bound in ange-ftp-get-process. |
;; `ange-ftp-this-host' and `ange-ftp-this-user' are bound in |
6020 |
(puthash (concat host "/" user "/~") |
;; ange-ftp-get-process. |
6021 |
(car (ange-ftp-get-pwd host user)) |
(puthash (concat ange-ftp-this-host "/" ange-ftp-this-user "/~") |
6022 |
|
(car (ange-ftp-get-pwd ange-ftp-this-host ange-ftp-this-user)) |
6023 |
ange-ftp-expand-dir-hashtable)))) |
ange-ftp-expand-dir-hashtable)))) |
6024 |
|
|
6025 |
;; Not available yet: |
;; Not available yet: |