[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el |
|
Date: |
Thu, 29 Aug 2002 17:48:50 -0400 |
Index: emacs/lisp/net/ange-ftp.el
diff -c emacs/lisp/net/ange-ftp.el:1.44 emacs/lisp/net/ange-ftp.el:1.45
*** emacs/lisp/net/ange-ftp.el:1.44 Tue Aug 27 17:21:17 2002
--- emacs/lisp/net/ange-ftp.el Thu Aug 29 17:48:50 2002
***************
*** 1416,1423 ****
(defmacro ange-ftp-ftp-name-component (n ns name)
"Extract the Nth ftp file name component from NS."
`(let ((elt (nth ,n ,ns)))
! (if (match-beginning elt)
! (substring ,name (match-beginning elt) (match-end elt)))))
(defvar ange-ftp-ftp-name-arg "")
(defvar ange-ftp-ftp-name-res nil)
--- 1416,1422 ----
(defmacro ange-ftp-ftp-name-component (n ns name)
"Extract the Nth ftp file name component from NS."
`(let ((elt (nth ,n ,ns)))
! (match-string elt ,name)))
(defvar ange-ftp-ftp-name-arg "")
(defvar ange-ftp-ftp-name-res nil)
***************
*** 1504,1522 ****
(defun ange-ftp-quote-string (string)
"Quote any characters in STRING that may confuse the ftp process."
! (apply (function concat)
! (mapcar (function
! ;; This is said to be wrong; ftp is said to
! ;; need quoting only for ", and that by doubling it.
! ;; But experiment says this kind of quoting is correct
! ;; when talking to ftp on GNU/Linux systems.
! (lambda (char)
! (if (or (<= char ? )
! (> char ?\~)
! (= char ?\")
! (= char ?\\))
! (vector ?\\ char)
! (vector char))))
string)))
(defun ange-ftp-barf-if-not-directory (directory)
--- 1503,1520 ----
(defun ange-ftp-quote-string (string)
"Quote any characters in STRING that may confuse the ftp process."
! (apply 'concat
! (mapcar (lambda (char)
! ;; This is said to be wrong; ftp is said to
! ;; need quoting only for ", and that by doubling it.
! ;; But experiment says this kind of quoting is correct
! ;; when talking to ftp on GNU/Linux systems.
! (if (or (<= char ? )
! (> char ?\~)
! (= char ?\")
! (= char ?\\))
! (vector ?\\ char)
! (vector char)))
string)))
(defun ange-ftp-barf-if-not-directory (directory)
***************
*** 1538,1546 ****
good, skip, fatal, or unknown."
(cond ((string-match ange-ftp-xfer-size-msgs line)
(setq ange-ftp-xfer-size
! (/ (string-to-number (substring line
! (match-beginning 1)
! (match-end 1)))
1024)))
((string-match ange-ftp-skip-msgs line)
t)
--- 1536,1542 ----
good, skip, fatal, or unknown."
(cond ((string-match ange-ftp-xfer-size-msgs line)
(setq ange-ftp-xfer-size
! (/ (string-to-number (match-string 1 line))
1024)))
((string-match ange-ftp-skip-msgs line)
t)
***************
*** 1691,1698 ****
"When ftp process changes state, nuke all file-entries in cache."
(let ((name (process-name proc)))
(if (string-match "\\*ftp \\(address@hidden)@\\([^*]+\\)\\*" name)
! (let ((user (substring name (match-beginning 1) (match-end 1)))
! (host (substring name (match-beginning 2) (match-end 2))))
(ange-ftp-wipe-file-entries host user))))
(setq ange-ftp-ls-cache-file nil))
--- 1687,1694 ----
"When ftp process changes state, nuke all file-entries in cache."
(let ((name (process-name proc)))
(if (string-match "\\*ftp \\(address@hidden)@\\([^*]+\\)\\*" name)
! (let ((user (match-string 1 name))
! (host (match-string 2 name)))
(ange-ftp-wipe-file-entries host user))))
(setq ange-ftp-ls-cache-file nil))
***************
*** 1773,1782 ****
(start-process name name
ange-ftp-gateway-program
ange-ftp-gateway-host)))
! (ftp (mapconcat (function identity) args " ")))
(process-kill-without-query proc)
! (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
! (set-process-filter proc (function ange-ftp-gwp-filter))
(save-excursion
(set-buffer (process-buffer proc))
(goto-char (point-max))
--- 1769,1778 ----
(start-process name name
ange-ftp-gateway-program
ange-ftp-gateway-host)))
! (ftp (mapconcat 'identity args " ")))
(process-kill-without-query proc)
! (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
! (set-process-filter proc 'ange-ftp-gwp-filter)
(save-excursion
(set-buffer (process-buffer proc))
(goto-char (point-max))
***************
*** 1890,1897 ****
(accept-process-output proc))
(goto-char (point-min))
(if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
! (setq res (buffer-substring (match-beginning 1)
! (match-end 1))))
(kill-buffer (current-buffer)))
res)
host))
--- 1886,1892 ----
(accept-process-output proc))
(goto-char (point-min))
(if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
! (setq res (match-string 1)))
(kill-buffer (current-buffer)))
res)
host))
***************
*** 1942,1949 ****
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
(process-kill-without-query proc)
! (set-process-sentinel proc (function ange-ftp-process-sentinel))
! (set-process-filter proc (function ange-ftp-process-filter))
;; On Windows, the standard ftp client buffers its output (because
;; stdout is a pipe handle) so the startup message may never appear:
;; `accept-process-output' at this point would hang indefinitely.
--- 1937,1944 ----
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
(process-kill-without-query proc)
! (set-process-sentinel proc 'ange-ftp-process-sentinel)
! (set-process-filter proc 'ange-ftp-process-filter)
;; On Windows, the standard ftp client buffers its output (because
;; stdout is a pipe handle) so the startup message may never appear:
;; `accept-process-output' at this point would hang indefinitely.
***************
*** 2092,2098 ****
ange-ftp-skip-msgs skip)))
(or (car result)
(progn
! (ange-ftp-set-passwd host user nil) ;reset password.
(ange-ftp-set-account host user nil) ;reset account.
(ange-ftp-error host user
(concat "USER request failed: "
--- 2087,2093 ----
ange-ftp-skip-msgs skip)))
(or (car result)
(progn
! (ange-ftp-set-passwd host user nil) ;reset password.
(ange-ftp-set-account host user nil) ;reset account.
(ange-ftp-error host user
(concat "USER request failed: "
***************
*** 2112,2121 ****
(line (cdr status)))
(save-match-data
(if (string-match ange-ftp-hash-mark-msgs line)
! (let ((size (string-to-int
! (substring line
! (match-beginning 1)
! (match-end 1)))))
(setq ange-ftp-ascii-hash-mark-size size
ange-ftp-hash-mark-unit (ash size -4))
--- 2107,2113 ----
(line (cdr status)))
(save-match-data
(if (string-match ange-ftp-hash-mark-msgs line)
! (let ((size (string-to-int (match-string 1 line))))
(setq ange-ftp-ascii-hash-mark-size size
ange-ftp-hash-mark-unit (ash size -4))
***************
*** 2163,2169 ****
;; Run any user-specified hooks. Note that proc, host and user are
;; dynamically bound at this point.
! (run-hooks 'ange-ftp-process-startup-hook))
proc)))
(defun ange-ftp-passive-mode (proc on-or-off)
--- 2155,2163 ----
;; Run any user-specified hooks. Note that proc, host and user are
;; dynamically bound at this point.
! (let ((ange-ftp-this-user user)
! (ange-ftp-this-host host))
! (run-hooks 'ange-ftp-process-startup-hook)))
proc)))
(defun ange-ftp-passive-mode (proc on-or-off)
***************
*** 2699,2706 ****
;; unquoting names obtained with the SysV b switch and the GNU Q
;; switch. See Sebastian's dired-get-filename.
! (defun ange-ftp-ls-parser ()
! ;; Note that switches is dynamically bound.
;; Meant to be called by ange-ftp-parse-dired-listing
(let ((tbl (make-hash-table :test 'equal))
(used-F (and (stringp switches)
--- 2693,2699 ----
;; unquoting names obtained with the SysV b switch and the GNU Q
;; switch. See Sebastian's dired-get-filename.
! (defun ange-ftp-ls-parser (switches)
;; Meant to be called by ange-ftp-parse-dired-listing
(let ((tbl (make-hash-table :test 'equal))
(used-F (and (stringp switches)
***************
*** 2731,2742 ****
(and (not symlink) ; x bits don't mean a thing for symlinks
(string-match
"[xst]"
! (concat (buffer-substring
! (match-beginning 1) (match-end 1))
! (buffer-substring
! (match-beginning 2) (match-end 2))
! (buffer-substring
! (match-beginning 3) (match-end 3)))))))
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
;; and others don't. (sigh...) Beware, that some Unix's don't
;; seem to believe in the F-switch
--- 2724,2732 ----
(and (not symlink) ; x bits don't mean a thing for symlinks
(string-match
"[xst]"
! (concat (match-string 1)
! (match-string 2)
! (match-string 3))))))
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
;; and others don't. (sigh...) Beware, that some Unix's don't
;; seem to believe in the F-switch
***************
*** 2800,2806 ****
(forward-line 1)
;; Some systems put in a blank line here.
(if (eolp) (forward-line 1))
! (ange-ftp-ls-parser))
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
;; It's an ls error message.
nil)
--- 2790,2796 ----
(forward-line 1)
;; Some systems put in a blank line here.
(if (eolp) (forward-line 1))
! (ange-ftp-ls-parser switches))
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
;; It's an ls error message.
nil)
***************
*** 2814,2820 ****
nil)
((re-search-forward ange-ftp-date-regexp nil t)
(beginning-of-line)
! (ange-ftp-ls-parser))
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
;; It's a dl listing (I hope).
;; file is bound by the call to ange-ftp-ls
--- 2804,2810 ----
nil)
((re-search-forward ange-ftp-date-regexp nil t)
(beginning-of-line)
! (ange-ftp-ls-parser switches))
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
;; It's a dl listing (I hope).
;; file is bound by the call to ange-ftp-ls
***************
*** 2871,2877 ****
(defmacro ange-ftp-get-file-part (name)
`(let ((file (file-name-nondirectory ,name)))
(if (string-equal file "")
! "."
file)))
;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
--- 2861,2867 ----
(defmacro ange-ftp-get-file-part (name)
`(let ((file (file-name-nondirectory ,name)))
(if (string-equal file "")
! "."
file)))
;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
***************
*** 2882,2887 ****
--- 2872,2878 ----
;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
;; subdirectory. This is of course an OS dependent judgement.
+ (defvar dired-local-variables-file)
(defmacro ange-ftp-allow-child-lookup (dir file)
`(not
(let* ((efile ,file) ; expand once.
***************
*** 3024,3033 ****
(if (car result)
(save-match-data
(and (or (string-match "\"\\([^\"]*\\)\"" line)
! (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
! (setq dir (substring line
! (match-beginning 1)
! (match-end 1))))))
(cons dir line)))
;;; ------------------------------------------------------------
--- 3015,3022 ----
(if (car result)
(save-match-data
(and (or (string-match "\"\\([^\"]*\\)\"" line)
! (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
! (setq dir (match-string 1 line)))))
(cons dir line)))
;;; ------------------------------------------------------------
***************
*** 3061,3069 ****
(line (cdr result)))
(setq res
(if (string-match ange-ftp-expand-dir-regexp line)
! (substring line
! (match-beginning 1)
! (match-end 1))))))
(or res
(if (string-equal dir "~")
(setq res (car (ange-ftp-get-pwd host user)))
--- 3050,3056 ----
(line (cdr result)))
(setq res
(if (string-match ange-ftp-expand-dir-regexp line)
! (match-string 1 line)))))
(or res
(if (string-equal dir "~")
(setq res (car (ange-ftp-get-pwd host user)))
***************
*** 3098,3106 ****
;; Name starts with ~ or ~user. Resolve that part of the name
;; making it absolute then re-expand it.
((string-match "^~[^/]*" name)
! (let* ((tilda (substring name
! (match-beginning 0)
! (match-end 0)))
(rest (substring name (match-end 0)))
(dir (ange-ftp-expand-dir host user tilda)))
(if dir
--- 3085,3091 ----
;; Name starts with ~ or ~user. Resolve that part of the name
;; making it absolute then re-expand it.
((string-match "^~[^/]*" name)
! (let* ((tilda (match-string 0 name))
(rest (substring name (match-end 0)))
(dir (ange-ftp-expand-dir host user tilda)))
(if dir
***************
*** 3212,3219 ****
(let ((parsed (ange-ftp-ftp-name dir)))
(if parsed
(ange-ftp-replace-name-component
! dir
! (ange-ftp-real-directory-file-name (nth 2 parsed)))
(ange-ftp-real-directory-file-name dir))))
--- 3197,3204 ----
(let ((parsed (ange-ftp-ftp-name dir)))
(if parsed
(ange-ftp-replace-name-component
! dir
! (ange-ftp-real-directory-file-name (nth 2 parsed)))
(ange-ftp-real-directory-file-name dir))))
***************
*** 3595,3601 ****
;; filename
;; newname))
;; res)
! ;; (set-process-sentinel proc (function
ange-ftp-copy-file-locally-sentinel))
;; (process-kill-without-query proc)
;; (with-current-buffer (process-buffer proc)
;; (set (make-local-variable 'copy-cont) cont))))
--- 3580,3586 ----
;; filename
;; newname))
;; res)
! ;; (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel)
;; (process-kill-without-query proc)
;; (with-current-buffer (process-buffer proc)
;; (set (make-local-variable 'copy-cont) cont))))
***************
*** 3683,3689 ****
(if (and temp1 t-parsed)
(format "Getting %s" f-abbr)
(format "Copying %s to %s" f-abbr t-abbr)))
! (list (function ange-ftp-cf1)
filename newname binary msg
f-parsed f-host f-user f-name f-abbr
t-parsed t-host t-user t-name t-abbr
--- 3668,3674 ----
(if (and temp1 t-parsed)
(format "Getting %s" f-abbr)
(format "Copying %s to %s" f-abbr t-abbr)))
! (list 'ange-ftp-cf1
filename newname binary msg
f-parsed f-host f-user f-name f-abbr
t-parsed t-host t-user t-name t-abbr
***************
*** 3761,3767 ****
(if (and temp2 f-parsed)
(format "Putting %s" newname)
(format "Copying %s to %s" f-abbr t-abbr)))
! (list (function ange-ftp-cf2)
newname t-host t-user binary temp1 temp2 cont)
nowait))
--- 3746,3752 ----
(if (and temp2 f-parsed)
(format "Putting %s" newname)
(format "Copying %s to %s" f-abbr t-abbr)))
! (list 'ange-ftp-cf2
newname t-host t-user binary temp1 temp2 cont)
nowait))
***************
*** 3916,3927 ****
;;;; File name completion support.
;;;; ------------------------------------------------------------
- ;; 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))))
-
;; If the file entry is not a directory (nor a symlink pointing to a
directory)
;; returns whether the file (or file pointed to by the symlink) is ignored
;; by completion-ignored-extensions.
--- 3901,3906 ----
***************
*** 3952,3960 ****
(setq ange-ftp-this-dir
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
! (completions
! (all-completions file tbl
! (function ange-ftp-file-entry-active-p))))
;; see whether each matching file is a directory or not...
(mapcar
--- 3931,3937 ----
(setq ange-ftp-this-dir
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
! (completions (all-completions file tbl)))
;; see whether each matching file is a directory or not...
(mapcar
***************
*** 3994,4003 ****
(save-match-data
(or (ange-ftp-file-name-completion-1
file tbl ange-ftp-this-dir
! (function ange-ftp-file-entry-not-ignored-p))
(ange-ftp-file-name-completion-1
! file tbl ange-ftp-this-dir
! (function ange-ftp-file-entry-active-p)))))))
(if (ange-ftp-root-dir-p ange-ftp-this-dir)
(try-completion
--- 3971,3979 ----
(save-match-data
(or (ange-ftp-file-name-completion-1
file tbl ange-ftp-this-dir
! 'ange-ftp-file-entry-not-ignored-p)
(ange-ftp-file-name-completion-1
! file tbl ange-ftp-this-dir))))))
(if (ange-ftp-root-dir-p ange-ftp-this-dir)
(try-completion
***************
*** 4008,4014 ****
(ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
! (defun ange-ftp-file-name-completion-1 (file tbl dir predicate)
(let ((bestmatch (try-completion file tbl predicate)))
(if bestmatch
(if (eq bestmatch t)
--- 3984,3990 ----
(ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
! (defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate)
(let ((bestmatch (try-completion file tbl predicate)))
(if bestmatch
(if (eq bestmatch t)
***************
*** 4101,4111 ****
(nth 2 parsed))
(ange-ftp-real-file-name-as-directory
(nth 2 parsed)))))
! (abbr (ange-ftp-abbreviate-filename dir))
! (result (ange-ftp-send-cmd host user
! (list 'rmdir name)
! (format "Removing directory %s"
! abbr))))
(or (car result)
(ange-ftp-error host user
(format "Could not remove directory %s: %s"
--- 4077,4087 ----
(nth 2 parsed))
(ange-ftp-real-file-name-as-directory
(nth 2 parsed)))))
! (abbr (ange-ftp-abbreviate-filename dir))
! (result (ange-ftp-send-cmd host user
! (list 'rmdir name)
! (format "Removing directory %s"
! abbr))))
(or (car result)
(ange-ftp-error host user
(format "Could not remove directory %s: %s"
***************
*** 4514,4522 ****
;; ((equal dired-chown-program program))
(t (error "Unknown remote command: %s" program)))
(ftp-error (insert (format "%s: %s, %s\n"
! (nth 1 oops)
! (nth 2 oops)
! (nth 3 oops)))
;; Caller expects nonzero value to mean failure.
1)
(error (insert (format "%s\n" (nth 1 oops)))
--- 4490,4498 ----
;; ((equal dired-chown-program program))
(t (error "Unknown remote command: %s" program)))
(ftp-error (insert (format "%s: %s, %s\n"
! (nth 1 oops)
! (nth 2 oops)
! (nth 3 oops)))
;; Caller expects nonzero value to mean failure.
1)
(error (insert (format "%s\n" (nth 1 oops)))
***************
*** 4667,4673 ****
;; (t nil))))
;; (condition-case err
;; (funcall file-creator from to overwrite-confirmed
! ;; (list (function ange-ftp-dcf-2)
;; nil ;err
;; file-creator operation fn-list
;; name-constructor
--- 4643,4649 ----
;; (t nil))))
;; (condition-case err
;; (funcall file-creator from to overwrite-confirmed
! ;; (list 'ange-ftp-dcf-2
;; nil ;err
;; file-creator operation fn-list
;; name-constructor
***************
*** 4913,4928 ****
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
(let (drive dir file)
! (if (match-beginning 1)
! (setq drive (substring name
! (match-beginning 1)
! (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))))
(and dir
(setq dir (subst-char-in-string
?/ ?. (substring dir 1 -1) t)))
--- 4889,4897 ----
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
(let (drive dir file)
! (setq drive (match-string 1 name))
! (setq dir (match-string 2 name))
! (setq file (match-string 3 name))
(and dir
(setq dir (subst-char-in-string
?/ ?. (substring dir 1 -1) t)))
***************
*** 5008,5016 ****
;; Extract the next filename from a VMS dired-like listing.
(defun ange-ftp-parse-vms-filename ()
(if (re-search-forward
! ange-ftp-vms-filename-regexp
! nil t)
! (buffer-substring (match-beginning 0) (match-end 0))))
;; Parse the current buffer which is assumed to be in MultiNet FTP dir
;; format, and return a hashtable as the result.
--- 4977,4985 ----
;; Extract the next filename from a VMS dired-like listing.
(defun ange-ftp-parse-vms-filename ()
(if (re-search-forward
! ange-ftp-vms-filename-regexp
! nil t)
! (match-string 0)))
;; Parse the current buffer which is assumed to be in MultiNet FTP dir
;; format, and return a hashtable as the result.
***************
*** 5036,5045 ****
(puthash ".." t tbl))
tbl))
! (or (assq 'vms ange-ftp-parse-list-func-alist)
! (setq ange-ftp-parse-list-func-alist
! (cons '(vms . ange-ftp-parse-vms-listing)
! ange-ftp-parse-list-func-alist)))
;; This version only deletes file entries which have
;; explicit version numbers, because that is all VMS allows.
--- 5005,5012 ----
(puthash ".." t tbl))
tbl))
! (add-to-list 'ange-ftp-parse-list-func-alist
! '(vms . ange-ftp-parse-vms-listing))
;; This version only deletes file entries which have
;; explicit version numbers, because that is all VMS allows.
***************
*** 5103,5112 ****
(and (string-match regexp name)
(setq version
(max version
! (string-to-int
! (substring name
! (match-beginning 1)
! (match-end 1)))))))
files)
(setq version (1+ version))
(puthash
--- 5070,5076 ----
(and (string-match regexp name)
(setq version
(max version
! (string-to-int (match-string 1 name))))))
files)
(setq version (1+ version))
(puthash
***************
*** 5337,5344 ****
;; ;; If the file has numeric backup versions,
;; ;; put on ange-ftp-file-version-alist an element of the form
;; ;; (FILENAME . VERSION-NUMBER-LIST)
! ;; (dired-map-dired-file-lines (function
! ;; ange-ftp-dired-vms-collect-file-versions))
;; ;; Sort each VERSION-NUMBER-LIST,
;; ;; and remove the versions not to be deleted.
;; (let ((fval ange-ftp-file-version-alist))
--- 5301,5307 ----
;; ;; If the file has numeric backup versions,
;; ;; put on ange-ftp-file-version-alist an element of the form
;; ;; (FILENAME . VERSION-NUMBER-LIST)
! ;; (dired-map-dired-file-lines 'ange-ftp-dired-vms-collect-file-versions)
;; ;; Sort each VERSION-NUMBER-LIST,
;; ;; and remove the versions not to be deleted.
;; (let ((fval ange-ftp-file-version-alist))
***************
*** 5355,5362 ****
;; ;; Look at each file. If it is a numeric backup file,
;; ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
;; (dired-map-dired-file-lines
! ;; (function
! ;; ange-ftp-dired-vms-trample-file-versions mark))
;; (message (concat action " numerical backups...done"))))
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
--- 5318,5324 ----
;; ;; Look at each file. If it is a numeric backup file,
;; ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
;; (dired-map-dired-file-lines
! ;; 'ange-ftp-dired-vms-trample-file-versions mark)
;; (message (concat action " numerical backups...done"))))
;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
***************
*** 5458,5474 ****
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
(let (acct file)
! (if (match-beginning 1)
! (setq acct (substring name 0 (match-end 1))))
! (if (match-beginning 2)
! (setq file (substring name
! (match-beginning 2) (match-end 2))))
(concat (and acct (concat "/" acct "/"))
file))
(error "name %s didn't match" name))
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name)
! (concat (substring name 1 (match-end 1))
! (substring name (match-beginning 2) (match-end 2)))
;; Let's hope that mts will recognize it anyway.
name))))
--- 5420,5432 ----
(if reverse
(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
(let (acct file)
! (setq acct (match-string 1 name))
! (setq file (match-string 2 name))
(concat (and acct (concat "/" acct "/"))
file))
(error "name %s didn't match" name))
(if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name)
! (concat (match-string 1 name) (match-string 2 name))
;; Let's hope that mts will recognize it anyway.
name))))
***************
*** 5523,5532 ****
(puthash "." t tbl)
tbl))
! (or (assq 'mts ange-ftp-parse-list-func-alist)
! (setq ange-ftp-parse-list-func-alist
! (cons '(mts . ange-ftp-parse-mts-listing)
! ange-ftp-parse-list-func-alist)))
(defun ange-ftp-add-mts-host (host)
"Mark HOST as the name of a machine running MTS."
--- 5481,5488 ----
(puthash "." t tbl)
tbl))
! (add-to-list 'ange-ftp-parse-list-func-alist
! '(mts . ange-ftp-parse-mts-listing))
(defun ange-ftp-add-mts-host (host)
"Mark HOST as the name of a machine running MTS."
***************
*** 5627,5636 ****
(concat "/" name)
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
name)
! (let ((minidisk (substring name 1 (match-end 1))))
(if (match-beginning 2)
! (let ((file (substring name (match-beginning 2)
! (match-end 2)))
(cmd (concat "cd " minidisk))
;; Note that host and user are bound in the call
--- 5583,5591 ----
(concat "/" name)
(if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
name)
! (let ((minidisk (match-string 1 name)))
(if (match-beginning 2)
! (let ((file (match-string 2 name))
(cmd (concat "cd " minidisk))
;; Note that host and user are bound in the call
***************
*** 5672,5685 ****
((string-equal "/" dir-name)
(error "Cannot get listing for fictitious \"/\" directory"))
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
! (let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1)))
;; host and user are bound in the call to ange-ftp-send-cmd
(proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
(cmd (concat "cd " minidisk))
(file (if (match-beginning 2)
;; it's a single file
! (substring dir-name (match-beginning 2)
! (match-end 2))
;; use the wild-card
"*")))
(if (car (ange-ftp-raw-send-cmd proc cmd))
--- 5627,5639 ----
((string-equal "/" dir-name)
(error "Cannot get listing for fictitious \"/\" directory"))
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
! (let* ((minidisk (match-string 1 dir-name))
;; host and user are bound in the call to ange-ftp-send-cmd
(proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
(cmd (concat "cd " minidisk))
(file (if (match-beginning 2)
;; it's a single file
! (match-string 2 dir-name)
;; use the wild-card
"*")))
(if (car (ange-ftp-raw-send-cmd proc cmd))
***************
*** 5748,5768 ****
(while
(re-search-forward
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
! (puthash
! (concat (buffer-substring (match-beginning 1)
! (match-end 1))
! "."
! (buffer-substring (match-beginning 2)
! (match-end 2)))
! nil tbl)
(forward-line 1))
(puthash "." t tbl))
tbl))
! (or (assq 'cms ange-ftp-parse-list-func-alist)
! (setq ange-ftp-parse-list-func-alist
! (cons '(cms . ange-ftp-parse-cms-listing)
! ange-ftp-parse-list-func-alist)))
;;;;; Tree dired support:
--- 5702,5714 ----
(while
(re-search-forward
"^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
! (puthash (concat (match-string 1) "." (match-string 2)) nil tbl)
(forward-line 1))
(puthash "." t tbl))
tbl))
! (add-to-list 'ange-ftp-parse-list-func-alist
! '(cms . ange-ftp-parse-cms-listing))
;;;;; Tree dired support:
***************
*** 5943,5954 ****
(and userid (concat userid "."))
;; change every '/' in filename to a '.', normally not neccessary
(and filename
! (apply (function concat)
! (mapcar (function (lambda (char)
! (if (= char ?/)
! (vector ?.)
! (vector char))))
! filename))))))
;; Let's hope that BS2000 recognize this anyway:
name))))
--- 5889,5895 ----
(and userid (concat userid "."))
;; change every '/' in filename to a '.', normally not neccessary
(and filename
! (subst-char-in-string ?/ ?. filename)))))
;; Let's hope that BS2000 recognize this anyway:
name))))
***************
*** 6000,6007 ****
ange-ftp-bs2000-host-regexp)
ange-ftp-host-cache nil)))
- (defvar ange-ftp-bs2000-posix-hook-installed nil)
-
(defun ange-ftp-add-bs2000-posix-host (host)
"Mark HOST as the name of a machine running BS2000 with POSIX subsystem."
(interactive
--- 5941,5946 ----
***************
*** 6015,6023 ****
ange-ftp-bs2000-posix-host-regexp)
ange-ftp-host-cache nil))
;; Install CD hook to cd to posix on connecting:
! (and (not ange-ftp-bs2000-posix-hook-installed)
! (add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix)
! (setq ange-ftp-bs2000-posix-hook-installed t))
host)
(defconst ange-ftp-bs2000-filename-regexp
--- 5954,5960 ----
ange-ftp-bs2000-posix-host-regexp)
ange-ftp-host-cache nil))
;; Install CD hook to cd to posix on connecting:
! (add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix)
host)
(defconst ange-ftp-bs2000-filename-regexp
***************
*** 6039,6045 ****
;; Extract the next filename from a BS2000 dired-like listing.
(defun ange-ftp-parse-bs2000-filename ()
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t)
! (buffer-substring (match-beginning 2) (match-end 2))))
;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir
;; format, and return a hashtable as the result.
--- 5976,5982 ----
;; Extract the next filename from a BS2000 dired-like listing.
(defun ange-ftp-parse-bs2000-filename ()
(if (re-search-forward ange-ftp-bs2000-filename-regexp nil t)
! (match-string 2)))
;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir
;; format, and return a hashtable as the result.
***************
*** 6050,6056 ****
;; get current pubset
(goto-char (point-min))
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t)
! (setq pubset (buffer-substring (match-beginning 0) (match-end 0))))
;; add files to hashtable
(goto-char (point-min))
(save-match-data
--- 5987,5993 ----
;; get current pubset
(goto-char (point-min))
(if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t)
! (setq pubset (match-string 0)))
;; add files to hashtable
(goto-char (point-min))
(save-match-data
***************
*** 6065,6089 ****
ange-ftp-bs2000-additional-pubsets))
tbl))
! (or (assq 'bs2000 ange-ftp-parse-list-func-alist)
! (setq ange-ftp-parse-list-func-alist
! (cons '(bs2000 . ange-ftp-parse-bs2000-listing)
! ange-ftp-parse-list-func-alist)))
(defun ange-ftp-bs2000-cd-to-posix ()
"cd to POSIX subsystem if the current host matches
! ange-ftp-bs2000-posix-host-regexp. All BS2000 hosts with POSIX subsystem
! MUST BE EXPLICITLY SET with ange-ftp-add-bs2000-posix-host for they cannot
be recognized automatically (they are all valid BS2000 hosts too)."
! (if (and host (ange-ftp-bs2000-posix-host host))
(progn
;; change to POSIX:
; (ange-ftp-raw-send-cmd proc "cd %POSIX")
! (ange-ftp-cd host user "%POSIX")
;; put new home directory in the expand-dir hashtable.
! ;; `host' and `user' are bound in ange-ftp-get-process.
! (puthash (concat host "/" user "/~")
! (car (ange-ftp-get-pwd host user))
ange-ftp-expand-dir-hashtable))))
;; Not available yet:
--- 6002,6025 ----
ange-ftp-bs2000-additional-pubsets))
tbl))
! (add-to-list 'ange-ftp-parse-list-func-alist
! '(bs2000 . ange-ftp-parse-bs2000-listing))
(defun ange-ftp-bs2000-cd-to-posix ()
"cd to POSIX subsystem if the current host matches
! `ange-ftp-bs2000-posix-host-regexp'. All BS2000 hosts with POSIX subsystem
! MUST BE EXPLICITLY SET with `ange-ftp-add-bs2000-posix-host' for they cannot
be recognized automatically (they are all valid BS2000 hosts too)."
! (if (and ange-ftp-this-host (ange-ftp-bs2000-posix-host ange-ftp-this-host))
(progn
;; change to POSIX:
; (ange-ftp-raw-send-cmd proc "cd %POSIX")
! (ange-ftp-cd ange-ftp-this-host ange-ftp-this-user "%POSIX")
;; put new home directory in the expand-dir hashtable.
! ;; `ange-ftp-this-host' and `ange-ftp-this-user' are bound in
! ;; ange-ftp-get-process.
! (puthash (concat ange-ftp-this-host "/" ange-ftp-this-user "/~")
! (car (ange-ftp-get-pwd ange-ftp-this-host ange-ftp-this-user))
ange-ftp-expand-dir-hashtable))))
;; Not available yet: