From: ange@hplb.hpl.hp.com (Andy Norman)
Subject: ange-ftp 4.20, part 6 of 8
Organization: Source only  Discussion and requests in gnu.emacs.help.
Distribution: gnu
Date: Wed, 19 Aug 1992 09:15:07 GMT

Submitted-by: ange@hplb.hpl.hp.com
Archive-name: ange-ftp/part06

---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is ange-ftp.06 (part 6 of ange-ftp)
# do not concatenate these parts, unpack them in order with /bin/sh
# file ange-ftp.el continued
#
if test ! -r _shar_seq_.tmp; then
	echo 'Please unpack part 1 first!'
	exit 1
fi
(read Scheck
 if test "$Scheck" != 6; then
	echo Please unpack part "$Scheck" next!
	exit 1
 else
	exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test -f _shar_wnt_.tmp; then
sed 's/^X//' << 'SHAR_EOF' >> 'ange-ftp.el' &&
X	    (let ((files (ange-ftp-get-hash-entry
X			  (file-name-directory path)
X			  ange-ftp-files-hashtable)))
X	      (if files
X		  (let* ((root (substring file 0
X					  (match-beginning 0)))
X			 (regexp (concat "^"
X					 (regexp-quote root)
X					 ";[0-9]+$"))
X			 versions)
X		    (ange-ftp-del-hash-entry file files)
X		    ;; Now we need to check if there are any
X		    ;; versions left. If not, then delete the
X		    ;; root entry.
X		    (mapatoms
X		     '(lambda (sym)
X			(and (string-match regexp (get sym 'key))
X			     (setq versions t)))
X		     files)
X		    (or versions
X			(ange-ftp-del-hash-entry root files))))))))))
X
(or (assq 'vms ange-ftp-delete-file-entry-alist)
X    (setq ange-ftp-delete-file-entry-alist
X	  (cons '(vms . ange-ftp-vms-delete-file-entry)
X		ange-ftp-delete-file-entry-alist)))
X
(defun ange-ftp-vms-add-file-entry (path &optional dir-p)
X  (if dir-p
X      (ange-ftp-internal-add-file-entry path t)
X    (let ((files (ange-ftp-get-hash-entry
X		  (file-name-directory path)
X		  ange-ftp-files-hashtable)))
X      (if files
X	  (let ((file (ange-ftp-get-file-part path)))
X	    (ange-ftp-save-match-data
X	      (if (string-match ";[0-9]+$" file)
X		  (ange-ftp-put-hash-entry
X		   (substring file 0 (match-beginning 0))
X		   nil files)
X		;; Need to figure out what version of the file
X		;; is being added.
X		(let ((regexp (concat "^"
X				      (regexp-quote file)
X				      ";\\([0-9]+\\)$"))
X		      (version 0))
X		  (mapatoms
X		   '(lambda (sym)
X		      (let ((name (get sym 'key)))
X			(and (string-match regexp name)
X			     (setq version
X				   (max version
X					(string-to-int
X					 (substring name
X						    (match-beginning 1)
X						    (match-end 1))))))))
X		   files)
X		  (setq version (1+ version))
X		  (ange-ftp-put-hash-entry
X		   (concat file ";" (int-to-string version))
X		   nil files))))
X	    (ange-ftp-put-hash-entry file nil files))))))
X
(or (assq 'vms ange-ftp-add-file-entry-alist)
X    (setq ange-ftp-add-file-entry-alist
X	  (cons '(vms . ange-ftp-vms-add-file-entry)
X		ange-ftp-add-file-entry-alist)))
X
X
(defun ange-ftp-add-vms-host (host)
X  "Interactively adds a given HOST to ange-ftp-vms-host-regexp."
X  (interactive
X   (list (read-string "Host: "
X		      (let ((name (or (buffer-file-name)
X				      (and (eq major-mode 'dired-mode)
X					   dired-directory))))
X			(and name (car (ange-ftp-ftp-path name)))))))
X  (if (not (ange-ftp-vms-host host))
X      (setq ange-ftp-vms-host-regexp
X	    (concat "^" (regexp-quote host) "$"
X		    (and ange-ftp-vms-host-regexp "\\|")
X		    ange-ftp-vms-host-regexp)
X	    ange-ftp-host-cache nil)))
X
X
(defun ange-ftp-vms-file-name-as-directory (name)
X  (ange-ftp-save-match-data
X    (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
X	(setq name (substring name 0 (match-beginning 0))))
X    (ange-ftp-real-file-name-as-directory name)))
X
(or (assq 'vms ange-ftp-file-name-as-directory-alist)
X    (setq ange-ftp-file-name-as-directory-alist
X	  (cons '(vms . ange-ftp-vms-file-name-as-directory)
X		ange-ftp-file-name-as-directory-alist)))
X
;;; Tree dired support:
X
;; For this code I have borrowed liberally from Sebastian Kremer's
;; dired-vms.el
X
X
;; These regexps must be anchored to beginning of line.
;; Beware that the ftpd may put the device in front of the filename.
X
(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
X  "Regular expression to use to search for VMS executable files.")
X
(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
X  "Regular expression to use to search for VMS directories.")
X
(or (assq 'vms ange-ftp-dired-re-exe-alist)
X    (setq ange-ftp-dired-re-exe-alist
X	  (cons (cons 'vms  ange-ftp-dired-vms-re-exe)
X		ange-ftp-dired-re-exe-alist)))
X
(or (assq 'vms ange-ftp-dired-re-dir-alist)
X    (setq ange-ftp-dired-re-dir-alist
X	  (cons (cons 'vms  ange-ftp-dired-vms-re-dir)
X		ange-ftp-dired-re-dir-alist)))
X
(defun ange-ftp-dired-vms-insert-headerline (dir)
X  ;; VMS inserts a headerline. I would prefer the headerline
X  ;; to be in ange-ftp format. This version tries to
X  ;; be careful, because we can't count on a headerline
X  ;; over ftp, and we wouldn't want to delete anything
X  ;; important.
X  (save-excursion
X    (if (looking-at "^  wildcard ")
X	(forward-line 1))
X    (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
X	(delete-region (point) (match-end 0))))
X  (ange-ftp-real-dired-insert-headerline dir))
X
(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
X    (setq ange-ftp-dired-insert-headerline-alist
X	  (cons '(vms . ange-ftp-dired-vms-insert-headerline)
X		ange-ftp-dired-insert-headerline-alist)))
X
(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
X  "In dired, move to first char of filename on this line.
Returns position (point) or nil if no filename on this line."
X  ;; This is the VMS version.
X  (let (case-fold-search)
X    (or eol (setq eol (progn (end-of-line) (point))))
X    (beginning-of-line)
X    (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
X	(goto-char (match-beginning 1))
X      (if raise-error
X	  (error "No file on this line")
X	nil))))
X
(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
X    (setq ange-ftp-dired-move-to-filename-alist
X	  (cons '(vms . ange-ftp-dired-vms-move-to-filename)
X		ange-ftp-dired-move-to-filename-alist)))
X
(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
X  ;; Assumes point is at beginning of filename.
X  ;; So, it should be called only after (dired-move-to-filename t).
X  ;; case-fold-search must be nil, at least for VMS.
X  ;; On failure, signals an error or returns nil.
X  ;; This is the VMS version.
X  (let (opoint hidden case-fold-search)
X    (setq opoint (point))
X    (or eol (setq eol (save-excursion (end-of-line) (point))))
X    (setq hidden (and selective-display
X		      (save-excursion (search-forward "\r" eol t))))
X    (if hidden
X	nil
X      (re-search-forward ange-ftp-vms-filename-regexp eol t))
X    (or no-error
X	(not (eq opoint (point)))
X	(error
X	 (if hidden
X	     (substitute-command-keys
X	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
X	   "No file on this line")))
X    (if (eq opoint (point))
X	nil
X      (point))))
X
(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
X    (setq ange-ftp-dired-move-to-end-of-filename-alist
X	  (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
X		ange-ftp-dired-move-to-end-of-filename-alist)))
X
(defun ange-ftp-dired-vms-between-files ()
X  (save-excursion
X    (beginning-of-line)
X    (or (equal (following-char) 10) ; newline
X     (equal (following-char) 9)     ; tab
X     (progn (forward-char 2)
X	    (or (looking-at "Total of")
X		(equal (following-char) 32))))))
X
(or (assq 'vms ange-ftp-dired-between-files-alist)
X    (setq ange-ftp-dired-between-files-alist
X	  (cons '(vms . ange-ftp-dired-vms-between-files)
X		ange-ftp-dired-between-files-alist)))
X
;; Beware! In VMS filenames must be of the form "FILE.TYPE".
;; Therefore, we cannot just append a ".Z" to filenames for
;; compressed files. Instead, we turn "FILE.TYPE" into
;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
X
(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
X  (if reverse
X      (cond
X       ((string-match "-Z;[0-9]+$" name)
X	(substring name 0 (match-beginning 0)))
X       ((string-match ";[0-9]+$" name)
X	(substring name 0 (match-beginning 0)))
X       ((string-match "-Z$" name)
X	(substring name 0 -2))
X       (t name))
X    (if (string-match ";[0-9]+$" name)
X	(concat (substring name 0 (match-beginning 0))
X		"-Z")
X      (concat name "-Z"))))
X
(or (assq 'vms ange-ftp-dired-compress-make-compressed-filename-alist)
X    (setq ange-ftp-dired-compress-make-compressed-filename-alist
X	  (cons '(vms . ange-ftp-vms-make-compressed-filename)
X		ange-ftp-dired-compress-make-compressed-filename-alist)))
X
;; When the filename is too long, VMS will use two lines to list a file
;; (damn them!) This will confuse dired. To solve this, need to convince
;; Sebastian to use a function dired-go-to-end-of-file-line, instead of
;; (forward-line 1). This would require a number of changes to dired.el.
;; If dired gets confused, revert-buffer will fix it.
X
(defun ange-ftp-dired-vms-ls-trim ()
X  (goto-char (point-min))
X  (let ((case-fold-search nil))
X    (re-search-forward  ange-ftp-vms-filename-regexp))
X  (beginning-of-line)
X  (delete-region (point-min) (point))
X  (forward-line 1)
X  (delete-region (point) (point-max)))
X
X
(or (assq 'vms ange-ftp-dired-ls-trim-alist)
X    (setq ange-ftp-dired-ls-trim-alist
X	  (cons '(vms . ange-ftp-dired-vms-ls-trim)
X		ange-ftp-dired-ls-trim-alist)))	
X
(defun ange-ftp-vms-bob-version (name)
X  (ange-ftp-save-match-data
X    (if (string-match ";[0-9]+$" name)
X	(substring name 0 (match-beginning 0))
X      name)))
X
(or (assq 'vms ange-ftp-bob-version-alist)
X    (setq ange-ftp-bob-version-alist
X	  (cons '(vms . ange-ftp-vms-bob-version)
X		ange-ftp-bob-version-alist)))
X
;;; The vms version of clean-directory has 2 more optional args
;;; than the usual dired version. This is so that it can be used by
;;; ange-ftp-dired-vms-flag-backup-files.
X
(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
X  "Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
Positive prefix arg KEEP overrides `dired-kept-versions';
Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
X
To clear the flags on these files, you can use \\[dired-flag-backup-files]
with a prefix argument."
;  (interactive "P") ; Never actually called interactively.
X  (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions)))
X  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
X	;; late-retention must NEVER be allowed to be less than 1 in VMS!
X	;; This could wipe ALL copies of the file.
X	(late-retention (max 1 (if (<= keep 0) dired-kept-versions keep)))
X	(action (or msg "Cleaning"))
X	(trample-marker (or marker dired-del-marker))
X	(file-version-assoc-list ()))
X    (message (concat action
X		     " numerical backups (keeping %d late, %d old)...")
X	     late-retention early-retention)
X    ;; Look at each file.
X    ;; If the file has numeric backup versions,
X    ;; put on file-version-assoc-list an element of the form
X    ;; (FILENAME . VERSION-NUMBER-LIST)
X    (dired-map-dired-file-lines (function
X				 ange-ftp-dired-vms-collect-file-versions))
X    ;; Sort each VERSION-NUMBER-LIST,
X    ;; and remove the versions not to be deleted.
X    (let ((fval file-version-assoc-list))
X      (while fval
X	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
X	       (v-count (length sorted-v-list)))
X	  (if (> v-count (+ early-retention late-retention))
X	      (rplacd (nthcdr early-retention sorted-v-list)
X		      (nthcdr (- v-count late-retention)
X			      sorted-v-list)))
X	  (rplacd (car fval)
X		  (cdr sorted-v-list)))
X	(setq fval (cdr fval))))
X    ;; Look at each file.  If it is a numeric backup file,
X    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
X    (dired-map-dired-file-lines
X     (function
X      ange-ftp-dired-vms-trample-file-versions mark))
X    (message (concat action " numerical backups...done"))))
X
(or (assq 'vms ange-ftp-dired-clean-directory-alist)
X    (setq ange-ftp-dired-clean-directory-alist
X	  (cons '(vms . ange-ftp-dired-vms-clean-directory)
X		ange-ftp-dired-clean-directory-alist)))
X
(defun ange-ftp-dired-vms-collect-file-versions (fn)
X  ;;  "If it looks like file FN has versions, return a list of the versions.
X  ;;That is a list of strings which are file names.
X  ;;The caller may want to flag some of these files for deletion."
(let ((path (nth 2 (ange-ftp-ftp-path fn))))
X  (if (string-match ";[0-9]+$" path)
X      (let* ((path (substring path 0 (match-beginning 0)))
X	     (fn (ange-ftp-replace-path-component fn path)))
X	(if (not (assq fn file-version-assoc-list))
X	    (let* ((base-versions
X		    (concat (file-name-nondirectory path) ";"))
X		   (bv-length (length base-versions))
X		   (possibilities (file-name-all-completions
X				   base-versions
X				   (file-name-directory fn)))
X		   (versions (mapcar
X			      '(lambda (arg)
X				 (if (and (string-match
X					   "[0-9]+$" arg bv-length)
X					  (= (match-beginning 0) bv-length))
X				     (string-to-int (substring arg bv-length))
X				   0))
X			      possibilities)))
X	      (if versions
X		  (setq
X		   file-version-assoc-list
X		   (cons (cons fn versions)
X			 file-version-assoc-list)))))))))
X
(defun ange-ftp-dired-vms-trample-file-versions (fn)
X  (let* ((start-vn (string-match ";[0-9]+$" fn))
X	 base-version-list)
X    (and start-vn
X	 (setq base-version-list	; there was a base version to which
X	       (assoc (substring fn 0 start-vn)	; this looks like a
X		      file-version-assoc-list))	; subversion
X	 (not (memq (string-to-int (substring fn (1+ start-vn)))
X		    base-version-list))	; this one doesn't make the cut
X	 (progn (beginning-of-line)
X		(delete-char 1)
X		(insert trample-marker)))))
X
(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
X  (let ((dired-kept-versions 1)
X	(kept-old-versions 0)
X	marker msg)
X    (if unflag-p
X	(setq marker ?\040 msg "Unflagging")
X      (setq marker dired-del-marker msg "Cleaning"))
X    (ange-ftp-dired-vms-clean-directory nil marker msg)))
X
(or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
X    (setq ange-ftp-dired-flag-backup-files-alist
X	  (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
X		ange-ftp-dired-flag-backup-files-alist)))
X
(defun ange-ftp-dired-vms-backup-diff (&optional switches)
X  (let ((file (dired-get-filename 'no-dir))
X	bak)
X    (if (and (string-match ";[0-9]+$" file)
X	     ;; Find most recent previous version.
X	     (let ((root (substring file 0 (match-beginning 0)))
X		   (ver
X		    (string-to-int (substring file (1+ (match-beginning 0)))))
X		   found)
X	       (setq ver (1- ver))
X	       (while (and (> ver 0) (not found))
X		 (setq bak (concat root ";" (int-to-string ver)))
X		 (and (file-exists-p bak) (setq found t))
X		 (setq ver (1- ver)))
X	       found))
X	(if switches
X	    (diff (expand-file-name bak) (expand-file-name file) switches)
X	  (diff (expand-file-name bak) (expand-file-name file)))
X      (error "No previous version found for %s" file))))
X
(or (assq 'vms ange-ftp-dired-backup-diff-alist)
X    (setq ange-ftp-dired-backup-diff-alist
X	  (cons '(vms . ange-ftp-dired-vms-backup-diff)
X		ange-ftp-dired-backup-diff-alist)))
X
X
;;;; ------------------------------------------------------------
;;;; MTS support
;;;; ------------------------------------------------------------
X
X
(defun ange-ftp-fix-path-for-mts (path &optional reverse)
X  "Convert PATH from UNIX-ish to MTS. If REVERSE given then convert from
MTS to UNIX-ish."
X  (ange-ftp-save-match-data
X    (if reverse
X	(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" path)
X	    (let (acct file)
X	      (if (match-beginning 1)
X		  (setq acct (substring path 0 (match-end 1))))
X	      (if (match-beginning 2)
X		  (setq file (substring path
X					(match-beginning 2) (match-end 2))))
X	      (concat (and acct (concat "/" acct "/"))
X		      file))
X	  (error "path %s didn't match" path))
X      (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" path)
X	  (concat (substring path 1 (match-end 1))
X		  (substring path (match-beginning 2) (match-end 2)))
X	;; Let's hope that mts will recognize it anyway.
X	path))))
X
(or (assq 'mts ange-ftp-fix-path-func-alist)
X    (setq ange-ftp-fix-path-func-alist
X	  (cons '(mts . ange-ftp-fix-path-for-mts)
X		ange-ftp-fix-path-func-alist)))
X
(defun ange-ftp-fix-dir-path-for-mts (dir-path)
X  "Convert path from UNIX-ish to MTS ready for a DIRectory listing.
Remember that there are no directories in MTS."
X  (if (string-equal dir-path "/")
X      (error "Cannot get listing for fictitious \"/\" directory.")
X    (let ((dir-path (ange-ftp-fix-path-for-mts dir-path)))
X      (cond
X       ((string-equal dir-path "")
X	"?")
X       ((string-match ":$" dir-path)
X	(concat dir-path "?"))
X       (dir-path))))) ; It's just a single file.
X
(or (assq 'mts ange-ftp-fix-dir-path-func-alist)
X    (setq ange-ftp-fix-dir-path-func-alist
X	  (cons '(mts . ange-ftp-fix-dir-path-for-mts)
X		ange-ftp-fix-dir-path-func-alist)))
X
(or (memq 'mts ange-ftp-dumb-host-types)
X    (setq ange-ftp-dumb-host-types
X	  (cons 'mts ange-ftp-dumb-host-types)))
X
(defvar ange-ftp-mts-host-regexp nil)
X
(defun ange-ftp-mts-host (host)
X  "Return whether HOST is running MTS."
X  (and ange-ftp-mts-host-regexp
X       (ange-ftp-save-match-data
X	 (string-match ange-ftp-mts-host-regexp host))))
X
(defun ange-ftp-parse-mts-listing ()
X  "Parse the current buffer which is assumed to be in
mts ftp dir format."
X  (let ((tbl (ange-ftp-make-hashtable)))
X    (goto-char (point-min))
X    (ange-ftp-save-match-data
X      (while (re-search-forward ange-ftp-date-regexp nil t)
X	(end-of-line)
X	(skip-chars-backward " ")
X	(let ((end (point)))
X	  (skip-chars-backward "-A-Z0-9_.!")
X	  (ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl))
X	(forward-line 1)))
X      ;; Don't need to bother with ..
X    (ange-ftp-put-hash-entry "." t tbl)
X    tbl))
X
(or (assq 'mts ange-ftp-parse-list-func-alist)
X    (setq ange-ftp-parse-list-func-alist
X	  (cons '(mts . ange-ftp-parse-mts-listing)
X		ange-ftp-parse-list-func-alist)))
X
(defun ange-ftp-add-mts-host (host)
X  "Interactively adds a given HOST to ange-ftp-mts-host-regexp."
X  (interactive
X   (list (read-string "Host: "
X		      (let ((name (or (buffer-file-name)
X				      (and (eq major-mode 'dired-mode)
X					   dired-directory))))
X			(and name (car (ange-ftp-ftp-path name)))))))
X  (if (not (ange-ftp-mts-host host))
X      (setq ange-ftp-mts-host-regexp
X	    (concat "^" (regexp-quote host) "$"
X		    (and ange-ftp-mts-host-regexp "\\|")
X		    ange-ftp-mts-host-regexp)
X	    ange-ftp-host-cache nil)))
X
;;; Tree dired support:
X
;; There aren't too many systems left that use MTS. This dired support will
;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
;; implement ftp in the same way. If not, it might be necessary to make the
;; following more flexible.
X
(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
X  "In dired, move to first char of filename on this line.
Returns position (point) or nil if no filename on this line."
X  ;; This is the MTS version.
X  (or eol (setq eol (progn (end-of-line) (point))))
X  (beginning-of-line)
X  (if (re-search-forward
X       ange-ftp-date-regexp eol t)
X      (progn
X	(skip-chars-forward " ")          ; Eat blanks after date
X	(skip-chars-forward "0-9:" eol)   ; Eat time or year
X	(skip-chars-forward " " eol)      ; one space before filename
X	;; When listing an account other than the users own account it appends
X	;; ACCT: to the beginning of the filename. Skip over this.
X	(and (looking-at "[A-Z0-9_.]+:")
X	     (goto-char (match-end 0)))
X	(point))
X    (if raise-error
X	(error "No file on this line")
X      nil)))
X
(or (assq 'mts ange-ftp-dired-move-to-filename-alist)
X    (setq ange-ftp-dired-move-to-filename-alist
X	  (cons '(mts . ange-ftp-dired-mts-move-to-filename)
X		ange-ftp-dired-move-to-filename-alist)))
X
(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
X  ;; Assumes point is at beginning of filename.
X  ;; So, it should be called only after (dired-move-to-filename t).
X  ;; On failure, signals an error or returns nil.
X  ;; This is the MTS version.
X  (let (opoint hidden case-fold-search)
X    (setq opoint (point)
X	  eol (save-excursion (end-of-line) (point))
X	  hidden (and selective-display
X		      (save-excursion (search-forward "\r" eol t))))
X    (if hidden
X	nil
X      (skip-chars-forward "-A-Z0-9._!" eol))
X    (or no-error
X	(not (eq opoint (point)))
X	(error
X	 (if hidden
X	     (substitute-command-keys
X	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
X	   "No file on this line")))
X    (if (eq opoint (point))
X	nil
X      (point))))
X
(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
X    (setq ange-ftp-dired-move-to-end-of-filename-alist
X	  (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
X		ange-ftp-dired-move-to-end-of-filename-alist)))
X
;;;; ------------------------------------------------------------
;;;; CMS support
;;;; ------------------------------------------------------------
X
;; Since CMS doesn't have any full pathname syntax, we have to fudge
;; things with cd's. We actually send too many cd's, but is dangerous
;; to try to remember the current minidisk, because if the connection
;; is closed and needs to be reopened, we will find ourselves back in
;; the default minidisk. This is fairly likely since CMS ftp servers
;; usually close the connection after 5 minutes of inactivity.
X
;; Have I got the filename character set right?
X
(defun ange-ftp-fix-path-for-cms (path &optional reverse)
X  "Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
so we fudge things by sending cd's."
X  (ange-ftp-save-match-data
X    (if reverse
X	;; Since we only convert output from a pwd in this direction,
X	;; we'll assume that it's a minidisk, and make it into a
X	;; directory file name. Note that the expand-dir-hashtable
X	;; stores directories without the trailing /. Is this
X	;; consistent?
X	(concat "/" path)
X      (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
X			path)
X	  (let ((minidisk (substring path 1 (match-end 1))))
X	    (if (match-beginning 2)
X		(let ((file (substring path (match-beginning 2)
X				       (match-end 2)))
X		      (cmd (concat "cd " minidisk))
X
X		      ;; Note that host and user are bound in the call
X		      ;; to ange-ftp-send-cmd
X		      (proc (ange-ftp-get-process host user)))
X
X		  ;; Must use ange-ftp-raw-send-cmd here to avoid
X		  ;; an infinite loop.
X		  (if (car (ange-ftp-raw-send-cmd proc cmd msg))
X		      file
X		    ;; failed... try ONCE more.
X		    (setq proc (ange-ftp-get-process host user))
X		    (let ((result (ange-ftp-raw-send-cmd proc cmd msg)))
X		      (if (car result)
X			  file
X			;; failed.  give up.
X			(ange-ftp-error host user
X					(format "cd to minidisk %s failed: %s"
X						minidisk (cdr result)))))))
X	      ;; return the minidisk
X	      minidisk))
X	(error "Invalid CMS filename")))))
X
(or (assq 'cms ange-ftp-fix-path-func-alist)
X    (setq ange-ftp-fix-path-func-alist
X	  (cons '(cms . ange-ftp-fix-path-for-cms)
X		ange-ftp-fix-path-func-alist)))
X
(or (memq 'cms ange-ftp-dumb-host-types)
X    (setq ange-ftp-dumb-host-types
X	  (cons 'cms ange-ftp-dumb-host-types)))
X
(defun ange-ftp-fix-dir-path-for-cms (dir-path)
X  "Convert path from UNIX-ish to VMS ready for a DIRectory listing."
X  (cond
X   ((string-equal "/" dir-path)
X    (error "Cannot get listing for fictitious \"/\" directory."))
X   ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-path)
X    (let* ((minidisk (substring dir-path (match-beginning 1) (match-end 1)))
X	   ;; host and user are bound in the call to ange-ftp-send-cmd
X	   (proc (ange-ftp-get-process host user))
X	   (cmd (concat "cd " minidisk))
X	   (file (if (match-beginning 2)
X		     ;; it's a single file
X		     (substring path (match-beginning 2)
X				(match-end 2))
X		   ;; use the wild-card
X		   "*")))
X      (if (car (ange-ftp-raw-send-cmd proc cmd))
X	  file
X	;; try again...
X	(setq proc (ange-ftp-get-process host user))
X	(let ((result (ange-ftp-raw-send-cmd proc cmd)))
X	  (if (car result)
X	      file
X	    ;; give up
X	    (ange-ftp-error host user
X			    (format "cd to minidisk %s failed: "
X				    minidisk (cdr result))))))))
X   (t (error "Invalid CMS pathname"))))
X
(or (assq 'cms ange-ftp-fix-dir-path-func-alist)
X    (setq ange-ftp-fix-dir-path-func-alist
X	  (cons '(cms . ange-ftp-fix-dir-path-for-cms)
X		ange-ftp-fix-dir-path-func-alist)))
X
(defvar ange-ftp-cms-host-regexp nil
X  "Regular expression to match hosts running the CMS operating system.")
X
(defun ange-ftp-cms-host (host)
X  "Return whether the host is running CMS."
X  (and ange-ftp-cms-host-regexp
X       (ange-ftp-save-match-data
X	 (string-match ange-ftp-cms-host-regexp host))))
X
(defun ange-ftp-add-cms-host (host)
X  "Interactively adds a given HOST to ange-ftp-cms-host-regexp."
X  (interactive
X   (list (read-string "Host: "
X		      (let ((name (or (buffer-file-name)
X				      (and (eq major-mode 'dired-mode)
X					   dired-directory))))
X			(and name (car (ange-ftp-ftp-path name)))))))
X  (if (not (ange-ftp-cms-host host))
X      (setq ange-ftp-cms-host-regexp
X	    (concat "^" (regexp-quote host) "$"
X		    (and ange-ftp-cms-host-regexp "\\|")
X		    ange-ftp-cms-host-regexp)
X	    ange-ftp-host-cache nil)))
X
(defun ange-ftp-parse-cms-listing ()
X  "Parse the current buffer which is assumed to be a CMS directory listing."
X  ;; If we succeed in getting a listing, then we will assume that the minidisk
X  ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
X  ;; because ange-ftp doesn't know that the root hashtable has only part of
X  ;; the info. It will assume that if a minidisk isn't in it, then it doesn't
X  ;; exist. It would be nice if completion worked for minidisks, as we
X  ;; discover them.
;  (let* ((dir-file (directory-file-name file))
;	 (root (file-name-directory dir-file))
;	 (minidisk (ange-ftp-get-file-part dir-file))
;	 (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
;    (if root-tbl
;	(ange-ftp-put-hash-entry minidisk t root-tbl)
;      (setq root-tbl (ange-ftp-make-hashtable))
;      (ange-ftp-put-hash-entry minidisk t root-tbl)
;      (ange-ftp-put-hash-entry "." t root-tbl)
;      (ange-ftp-set-files root root-tbl)))
X  ;; Now do the usual parsing
X  (let ((tbl (ange-ftp-make-hashtable)))
X    (goto-char (point-min))
X    (ange-ftp-save-match-data
X      (while
X	  (re-search-forward
X	   "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
X	(ange-ftp-put-hash-entry
X	 (concat (buffer-substring (match-beginning 1)
X				   (match-end 1))
X		 "."
X		 (buffer-substring (match-beginning 2)
X				   (match-end 2)))
X	 nil tbl)
X	(forward-line 1))
X      (ange-ftp-put-hash-entry "." t tbl))
X    tbl))
X
(or (assq 'cms ange-ftp-parse-list-func-alist)
X    (setq ange-ftp-parse-list-func-alist
X	  (cons '(cms . ange-ftp-parse-cms-listing)
X		ange-ftp-parse-list-func-alist)))
X    
;;; Tree dired support:
X
(defconst ange-ftp-dired-cms-re-exe
X  "^. [-A-Z0-9$_]+ +EXEC "
X  "Regular expression to use to search for CMS executables.")
X
(or (assq 'cms ange-ftp-dired-re-exe-alist)
X    (setq ange-ftp-dired-re-exe-alist
X	  (cons (cons 'cms  ange-ftp-dired-cms-re-exe)
X		ange-ftp-dired-re-exe-alist)))
X
X
(defun ange-ftp-dired-cms-insert-headerline (dir)
X  ;; CMS has no total line, so we insert a blank line for
X  ;; aesthetics.
X  (insert "\n")
X  (forward-char -1)
X  (ange-ftp-real-dired-insert-headerline dir))
X
(or (assq 'cms ange-ftp-dired-insert-headerline-alist)
X    (setq ange-ftp-dired-insert-headerline-alist
X	  (cons '(cms . ange-ftp-dired-cms-insert-headerline)
X		ange-ftp-dired-insert-headerline-alist)))
X
(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
X  "In dired, move to the first char of filename on this line."
X  ;; This is the CMS version.
X  (or eol (setq eol (progn (end-of-line) (point))))
X  (let (case-fold-search)
X    (beginning-of-line)
X    (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t)
X	(goto-char (1+ (match-beginning 0)))
X      (if raise-error
X	  (error "No file on this line")
X	nil))))
X
(or (assq 'cms ange-ftp-dired-move-to-filename-alist)
X    (setq ange-ftp-dired-move-to-filename-alist
X	  (cons '(cms . ange-ftp-dired-cms-move-to-filename)
X		ange-ftp-dired-move-to-filename-alist)))
X
(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
X  ;; Assumes point is at beginning of filename.
X  ;; So, it should be called only after (dired-move-to-filename t).
X  ;; case-fold-search must be nil, at least for VMS.
X  ;; On failure, signals an error or returns nil.
X  ;; This is the CMS version.
X  (let ((opoint (point))
X	case-fold-search hidden)
X    (or eol (setq eol (save-excursion (end-of-line) (point))))
X    (setq hidden (and selective-display
X		      (save-excursion
X			(search-forward "\r" eol t))))
X    (if hidden
X	(if no-error
X	    nil
X	  (error
X	   (substitute-command-keys
X	    "File line is hidden, type \\[dired-hide-subdir] to unhide")))
X      (skip-chars-forward "-A-Z0-9$_" eol)
X      (skip-chars-forward " " eol)
X      (skip-chars-forward "-A-Z0-9$_" eol)
X      (if (eq opoint (point))
X	  (if no-error
X	      nil
X	    (error "No file on this line"))
X	(point)))))
X
(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
X    (setq ange-ftp-dired-move-to-end-of-filename-alist
X	  (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
X		ange-ftp-dired-move-to-end-of-filename-alist)))
X
(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
X  (if reverse
X      (if (string-match "-Z$" name)
X	  (substring name 0 -2)
X	name)
X    (concat name "-Z")))
X
(or (assq 'cms ange-ftp-dired-compress-make-compressed-filename-alist)
X    (setq ange-ftp-dired-compress-make-compressed-filename-alist
X	  (cons '(cms . ange-ftp-cms-make-compressed-filename)
X		ange-ftp-dired-compress-make-compressed-filename-alist)))
X
(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
X  (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
X    (and name
X	 (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name)
X	     (concat (substring name 0 (match-end 1))
X		     "."
X		     (substring name (match-beginning 2) (match-end 2)))
X	   name))))
X
(or (assq 'cms ange-ftp-dired-get-filename-alist)
X    (setq ange-ftp-dired-get-filename-alist
X	  (cons '(cms . ange-ftp-dired-cms-get-filename)
X		ange-ftp-dired-get-filename-alist)))
X
;;;; ------------------------------------------------------------
;;;; Finally provide package.
;;;; ------------------------------------------------------------
X
(provide 'ange-ftp)
SHAR_EOF
chmod 0644 ange-ftp.el ||
echo 'restore of ange-ftp.el failed'
Wc_c="`wc -c < 'ange-ftp.el'`"
test 225017 -eq "$Wc_c" ||
	echo 'ange-ftp.el: original size 225017, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= ange-ftp.texinfo ==============
if test -f 'ange-ftp.texinfo' -a X"$1" != X"-c"; then
	echo 'x - skipping ange-ftp.texinfo (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
sed 's/^X//' << 'SHAR_EOF' > 'ange-ftp.texinfo' &&
\input texinfo   @c -*-texinfo-*-
@comment %**start of header (This is for running Texinfo on a region.)
@setfilename ange-ftp.info
@settitle ange-ftp
@comment %**end of header (This is for running Texinfo on a region.)
X
@synindex pg vr
X
@node Top, What is ange-ftp?, (dir), (dir)
@comment  node-name,  next,  previous,  up
@ifinfo
@unnumbered Ange-ftp
X
This file documents ange-ftp, a system for transparent file-transfer
between remote hosts using the FTP protocol within GNU Emacs.
X
This info is current to Version 4.2 of Ange-ftp.
X
Documentation version: 1.32
X
Copyright @copyright{} 1991, 1992 Free Software Foundation, Inc.
X
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.
X
@ignore
Permission is granted to process this file through TeX and print the
results, provided the printed document carries a copying permission
notice identical to this one except for the removal of this paragraph
(this paragraph not being relevant to the printed manual).
X
@end ignore
Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided that the
entire resulting derived work is distributed under the terms of a
permission notice identical to this one.
@end ifinfo
X
@titlepage
@sp5
@center @titlefont{ange-ftp}
@center version 4.2
@sp2
@center A transparent remote file system, by Andy Norman
@sp7
@center This documentation by David Smith.
@center info-version 1.32
@page
@vskip 0pt plus 1filll
Copyright @copyright{} 1991, 1992 Free Software Foundation, Inc.
X
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.
X
Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided that the
entire resulting derived work is distributed under the terms of a
permission notice identical to this one.
@end titlepage
X
@menu
* What is ange-ftp?::	A brief introduction to ange-ftp. Credits.
* Installing ange-ftp:: Where to find it, and how to use it.
* Using ange-ftp::	Ange-ftp -- a users' guide.
* Getting help::	Mailing lists and newsgroups.
* Bugs::		Known bugs, and a wish list.
X
Indices:
* Concept Index::
* Variable and command index::
@end menu
X
X
@node What is ange-ftp?, Installing ange-ftp, Top, Top
@comment  node-name,  next,  previous,  up
@chapter Introducing ange-ftp.
X
Ange-ftp is a system for transparent file-transfer between remote UNIX,
VMS, CMS or MTS
hosts using FTP. This means that you can edit, copy and otherwise
manipulate files on any machine you have access to from within GNU Emacs
as if it were a local file. Ange-ftp works by introducing an extended
filename syntax, and overloading functions such as
@code{insert-file-contents} so that accessing a remote file causes
appropriate commands to be sent to an FTP process. Ange-ftp works with
Dired (and in particular Sebastian Kremer's Tree Dired) to facilitate
directory browsing and multiple file transfer from remote hosts.
X
The author of ange-ftp is Andy (Ange) Norman (@code{ange@@hplb.hpl.hp.com}).
@ifinfo
Many people have sent in enhancements, and Ange has been kept quite
busy testing them and incorporating them into ange-ftp. Current members
of the Ange-Ftp Hall of Fame include:
X
@itemize @bullet
@item
Many thanks to Roland McGrath for improving the filename syntax handling,
for suggesting many enhancements and for numerous cleanups to the code.
X
@item
Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways.
X
@item
Thanks to Ken Laprade for improved @file{.netrc} parsing and password
reading, and Dired/shell autoloading.
X
@item
Thanks to Sebastian Kremer for tree dired support and for many ideas and
bugfixes.
X
@item
Thanks to Joe Wells for bugfixes, non-UNIX system support, VOS support,
and hostname completion.
X
@item
Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help
with file-name expansion, efficiency worries, stylistic concerns and many
bugfixes.
X
@item
Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
MTS, CMS and UNIX-dls.  Sandy also added dired-support for non-UNIX OS and
auto-recognition of the host type.
X
@item
Also, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher,
Ping Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd
Kaufmann, Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl
Edman, Bill Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve
Anderson, Sanjay Mathur, the folks on the ange-ftp-lovers mailing list
and many others whose names have been forgotten who have helped to debug
and fix problems with @file{ange-ftp.el}.
@end itemize
@end ifinfo
X
Finally, this info file was written by Dave Smith
(@code{dsmith@@stats.adelaide.edu.au}), although large chunks of it
@ifinfo
@noindent
(such as most of this node :-)
@end ifinfo
@noindent
are plagiarised straight out of the extensive
comments section of @file{ange-ftp.el}.
X
@node Installing ange-ftp, Using ange-ftp, What is ange-ftp?, Top
@comment  node-name,  next,  previous,  up
@chapter Installing ange-ftp
X
If you don't already have a copy of ange-ftp, or you want a later
version, ange-ftp is pretty easy to get hold of. FTP is the probably the
simplest method, but other options such as mail are available. 
X
Once you have the Emacs-Lisp source, there are a few customisations you
might need to make. The ideal configuration is to have the FTP process running
on the same machine as you are running Emacs on, but this is not always
possible since some machines cannot access hosts outside the local
network. In this case, the FTP process needs to be run on a machine
which @emph{does} have access to the local world --- this is called the
@strong{gateway host}. Ange-ftp has facilities to make use of a
gateway host when accessing remote hosts.
X
@menu
* Obtaining source code::	Where to find the ange-ftp source.
* Installing source::		Where to put it, how to load it.
* Using a gateway::		For when your local machine has limited access.
* Other options::		More user variables to twiddle.
@end menu
X
@node Obtaining source code, Installing source, ,Installing ange-ftp    
@section How to get the ange-ftp source code
@comment  node-name,  next,  previous,  up
X
The latest version of ange-ftp should always be available for anonymous
FTP from 
@example
alpha.gnu.ai.mit.edu
@end example
@noindent
in the file 
@example
ange-ftp/ange-ftp.tar.Z
@end example
@noindent
(which includes both @file{ange-ftp.el} and this texinfo file.) In ange-ftp
notation, that's
@example
/anonymous@@alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z
@end example
X
Alternatively, ange-ftp is also part of the Emacs-Lisp Archive
@cindex Emacs-Lisp Archive
on
@code{archive.cis.ohio-state.edu}. The latest version should always be
available on this site, but the Lisp-Code Directory entry is not always
up to date; it currently reads:
@example
ange-ftp (3.112)  91-08-12
X Andy Norman, <ange@@hplb.hpl.hp.com>
X archive.cis.ohio-state.edu:
X   /pub/gnu/emacs/elisp-archive/as-is/ange-ftp.el.Z
transparent FTP Support for GNU Emacs
@end example
X
Ange-ftp can also be found at:
@example
ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.el.Z
@end example
X
Failing these, someone on the ange-ftp mailing list (@xref{Getting
help}) or the author himself (@xref{What is ange-ftp?}) may be able to
help you find the latest version.
X
If you intend to do a lot of browsing though archive sites it is
definitely worth your while installing Sebastian Kremer's Tree Dired
@cindex Tree Dired, source
along with ange-ftp (if you haven't done it already). Tree Dired will
work with ange-ftp without any modifications: all you need to do is
follow the installation instructions that come with the package. The
Tree Dired package comes complete with the latest version of ange-ftp,
and is available for anonymous FTP from the following sites:
@example
ftp.thp.Uni-Koeln.DE:/pub/gnu/emacs/diredall.tar.Z  (134.95.64.1)
ftp.cs.buffalo.edu:pub/Emacs/diredall.tar.Z
@end example
@noindent
Alternatively, you can get in touch with Sebastian himself
using his e-mail address: @code{sk@@thp.Uni-Koeln.DE}.
X
@node Installing source, Using a gateway, Obtaining source code, Installing ange-ftp
@comment  node-name,  next,  previous,  up
@section Installing the source
X
Installation is simply a matter of copying the file @file{ange-ftp.el} 
to a directory in your load-path. If you don't already have a load-path,
this is probably a good time to make one. Just create a directory (say,
SHAR_EOF
true || echo 'restore of ange-ftp.texinfo failed'
fi
echo 'End of part 6, continue with part 7'
echo 7 > _shar_seq_.tmp
exit 0
Xref: sparky gnu.emacs.sources:607 comp.emacs:2880