#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  ange-ftp.el ange-ftp-dired.el
# Wrapped by sk@sun2 on Sun Feb  3 23:00:36 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ange-ftp.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ange-ftp.el'\"
else
echo shar: Extracting \"'ange-ftp.el'\" \(64065 characters\)
sed "s/^X//" >'ange-ftp.el' <<'END_OF_FILE'
X;; -*-Emacs-Lisp-*-
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;;
X;; File:         ange-ftp.el
X;; RCS:          $Header: /home/sk/lib/emacs/lisp/RCS/ange-ftp.el,v 3.72 1991/01/11 10:56:04 ange Exp $
X;; Description:  simple ftp access to files from GNU Emacs
X;; Author:       Andy Norman, ange@hplb.hpl.hp.com
X;; Created:      Thu Oct 12 14:00:05 1989
X;; Modified:     Fri Jan 11 10:54:38 1991 (Ange) ange@anorman
X;;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X
X;;; Copyright (C) 1990 Andy Norman.
X;;;
X;;; Author: Andy Norman (ange@hplb.hpl.hp.com)
X;;;
X;;; This program is free software; you can redistribute it and/or modify
X;;; it under the terms of the GNU General Public License as published by
X;;; the Free Software Foundation; either version 1, or (at your option)
X;;; any later version.
X;;;
X;;; This program is distributed in the hope that it will be useful,
X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;;; GNU General Public License for more details.
X;;;
X;;; A copy of the GNU General Public License can be obtained from this
X;;; program's author (send electronic mail to ange@hplb.hpl.hp.com) or from
X;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
X;;; 02139, USA.
X
X;;; This package attempts to make accessing files / directories using ftp from
X;;; within GNU Emacs as simple as possible.  A subset of the normal
X;;; file-handling routines are extended to understand ftp.
X;;;
X;;; To read or write a file using ftp, or to read a directory using ftp, the
X;;; only thing that a user needs to do is to specify the filename using a 
X;;; slighly extended syntax.
X;;;
X;;; The default syntax of ftp files is /user@host:path.  This is customizable.
X;;; See the variable ange-ftp-path-format for more details.
X;;;
X;;; A password is required for each host/user pair.  This will be prompted for
X;;; when needed, unless already set by calling ange-ftp-set-passwd, or
X;;; specified in a valid ~/.netrc file.
X;;;
X;;; Ftp processes are left running for speed.  They can easily be killed by
X;;; killing their associated buffers.
X;;;
X;;; Full file name completion is supported on remote files.
X;;;
X;;; File transfers can be done in binary mode. See the documentation for the
X;;; variable ange-ftp-binary-file-name-regexp for more details.
X;;;
X;;; The ftp process can be either be run locally, or run on a different machine.
X;;; Sometimes this is neccessary when the local machine does not have full internet
X;;; access.  See the documentation for the variables ange-ftp-gateway-host,
X;;; ange-ftp-local-host-regexp, ange-ftp-gateway-tmp-name-template, 
X;;; ange-ftp-gateway-program and ange-ftp-gateway-program-interactive for more
X;;; details.
X;;;
X;;; WARNING, the following GNU Emacs functions are replaced by this program:
X;;;
X;;;   write-region
X;;;   insert-file-contents
X;;;   dired-readin
X;;;   delete-file
X;;;   read-file-name-internal
X;;;   verify-visited-file-modtime
X;;;   directory-files
X;;;   backup-buffer
X;;;   file-directory-p
X;;;   file-writable-p
X;;;   file-exists-p
X;;;   file-readable-p
X;;;   file-attributes
X;;;   copy-file
X;;;   file-name-as-directory
X;;;   file-name-directory
X;;;   file-name-nondirectory
X;;;   directory-file-name
X;;;   expand-file-name
X;;;
X;;; If you find any bugs or problems with this package, please e-mail the
X;;; above author.  Constructive comments are especially welcome.
X;;;
X;;; Many thanks to Roland McGrath <roland@ai.mit.edu> for improving the
X;;; filename syntax handling, for suggesting many enhancements and for
X;;; numerous cleanups to the code.
X;;;
X;;; Thanks to Jamie Zawinski <jwz@lucid.com> for bugfixes and for ideas such
X;;; as gateways.
X;;;
X;;; Thanks to Ken Laprade <laprade@trantor.harris-atd.com> for improved .netrc
X;;; parsing and password reading.
X;;;
X;;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping
X;;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann and
X;;; many others whose names I've forgotten who have helped to debug and fix
X;;; problems in ange-ftp.el.
X
X;;;; ------------------------------------------------------------
X;;;; User customization variables.
X;;;; ------------------------------------------------------------
X
X(defvar ange-ftp-path-format
X  '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" . (3 2 4))
X  "*Format of a fully expanded remote pathname.  This is a cons
X\(REGEXP . \(HOST USER PATH\)\), where REGEXP is a regular expression matching
Xthe full remote pathname, and HOST, USER, and PATH are the numbers of
Xparenthesized expressions in REGEXP for the components (in that order).")
X
X(defvar ange-ftp-multi-msgs
X  "^[0-9][0-9][0-9]-"
X  "*Regular expression matching messages from the ftp process that start
Xa multiline reply.")
X
X(defvar ange-ftp-good-msgs
X  "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 "
X  "*Regular expression matching messages from the ftp process that indicate
Xthat the action that was initiated has completed successfully.")
X
X(defvar ange-ftp-skip-msgs
X  (concat "^200 PORT \\|^331 \\|^2.0-\\|^150 \\|^[0-9]+ bytes \\|"
X	  "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
X	  "^local:")
X  "*Regular expression matching messages from the ftp process that can be
Xignored.")
X
X(defvar ange-ftp-fatal-msgs
X  (concat "^ftp: \\|^Not connected\\|^530 \\|^421 \\|rcmd: \\|"
X	  "^No control connection")
X  "*Regular expression matching messages from the ftp process that indicate
Xsomething has gone drastically wrong attempting the action that was
Xinitiated.")
X
X(defvar ange-ftp-ls-follow-symbolic-links t
X  "*If non-nil, tell ls to always follow symbolic links.")
X
X(defvar ange-ftp-tmp-name-template "/tmp/ange-ftp"
X  "*Template given to make-temp-name to create temporary files.")
X
X(defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
X  "*Template given to make-temp-name to create temporary files when
Xftp-ing through a gateway.  Files starting with this prefix need to
Xbe accessible from BOTH the local machine and the gateway machine, 
Xand need to have the SAME name on both machines, that is, /tmp is probably
XNOT what you want, since that is rarely cross-mounted.")
X
X(defvar ange-ftp-copy-tmp-name-template "/tmp/ange-ftp-copy"
X  "*Template given to make-temp-name to to create temporary files when
Xcopying files between one remote machine and another.
XThis should be different from \`ange-ftp-tmp-name-template\' and
X\'ange-ftp-gateway-tmp-name-template\'.")
X
X(defvar ange-ftp-netrc-filename "~/.netrc"
X  "*File in .netrc format to search for passwords.")
X
X(defvar ange-ftp-default-user nil
X  "*User name to use when none is specied in a pathname.
XIf nil, then the name under which the user is logged in is used.
XIf non-nil but not a string, the user is prompted for the name.")
X
X(defvar ange-ftp-generate-anonymous-password nil
X  "*If non-nil, by default use a password of user@host when logging
Xin as the anonymous user.")
X
X(defvar ange-ftp-dumb-host-regexp nil
X  "*If non-nil, if the host being ftp'd to matches this regexp then the ftp
Xprocess uses the \'dir\' command to get directory information.")
X
X(defvar ange-ftp-binary-file-name-regexp
X  (concat "\\.Z$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
X	  "\\.dvi$\\|\\.ps$\\|\\.elc$")
X  "*If a file matches this regexp then it is transferred in binary mode.")
X
X(defvar ange-ftp-gateway-host nil
X  "*Name of host to use as gateway machine when local ftp isn't possible.")
X
X(defvar ange-ftp-local-host-regexp ".*"
X  "*If a host being ftp'd to matches this regexp then the ftp process is started
Xlocally, otherwise the ftp process is started on \`ange-ftp-gateway-host\'
Xinstead.")
X
X(defvar ange-ftp-gateway-program-interactive nil
X  "*If non-nil then the gateway program is expected to connect to the gateway
Xmachine and eventually give a shell prompt.  Both telnet and rlogin do something
Xlike this.")
X
X(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
X  "*Name of program to spawn a shell on the gateway machine.  Valid candidates
Xare remsh (rsh on hp-ux), telnet and rlogin.  See also the gateway variable
Xabove.")
X
X(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *"
X  "*Regexp used to detect that the logging-in sequence is completed on the
Xgateway machine and that the shell is now awaiting input.")
X
X(defvar ange-ftp-gateway-setup-term-command
X  (if (eq system-type 'hpux)
X      "stty -onlcr -echo\n"
X    "stty -echo nl\n")
X  "*Command to use after logging in to the gateway machine to stop the terminal
Xechoing each command and to strip out trailing ^M characters.")
X
X(defvar ange-ftp-smart-gateway nil
X  "*If the gateway ftp is smart enough to use proxy server, then don't bother
Xtelnetting etc, just issue a user@host command instead.")
X
X(defvar ange-ftp-smart-gateway-port "21"
X  "*Port on gateway machine to use when smart gateway is in operation.")
X
X;;;; ------------------------------------------------------------
X;;;; Hash table support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-make-hashtable (&optional size)
X  "Make an obarray suitable for use as a hashtable.
XSIZE, if supplied, should be a prime number."
X  (make-vector (or size 511) 0))
X
X(defun ange-ftp-map-hashtable (fun tbl)
X  "Call FUNCTION on each key and value in HASHTABLE."
X  (mapatoms
X   (function 
X    (lambda (sym)
X      (and (get sym 'active)
X	   (funcall fun (get sym 'key) (get sym 'val)))))
X   tbl))
X
X(defmacro ange-ftp-make-hash-key (key)
X  "Convert KEY into a suitable key for a hashtable."
X  (` (if (stringp (, key))
X	 (, key)
X       (prin1-to-string (, key)))))
X
X(defun ange-ftp-get-hash-entry (key tbl)
X  "Return the value associated with KEY in HASHTABLE."
X  (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
X    (and sym
X	 (get sym 'active)
X	 (get sym 'val))))
X
X(defun ange-ftp-put-hash-entry (key val tbl)
X  "Record an association between KEY and VALUE in HASHTABLE."
X  (let ((sym (intern (ange-ftp-make-hash-key key) tbl)))
X    (put sym 'val val)
X    (put sym 'key key)
X    (put sym 'active t)))
X
X(defun ange-ftp-del-hash-entry (key tbl)
X  "Delete KEY from HASHTABLE."
X  (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
X    (and sym (put sym 'active nil))))
X
X(defun ange-ftp-hash-entry-exists-p (key tbl)
X  "Return whether there is an association for KEY in TABLE."
X  (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
X    (and sym (get sym 'active))))
X
X(defun ange-ftp-hash-table-keys (tbl)
X  "Return a sorted list of all the active keys in the hashtable, as strings."
X  (sort (all-completions ""
X			 tbl
X			 (function (lambda (x) (get x 'active))))
X	(function string-lessp)))
X
X;;;; ------------------------------------------------------------
X;;;; Internal variables.
X;;;; ------------------------------------------------------------
X
X(defvar ange-ftp-data-buffer-name "*ftp data*"
X  "Buffer name to hold data received from ftp process.")
X
X(defvar ange-ftp-process-string ""
X  "Currently unprocessed output from the ftp process.")
X
X(defvar ange-ftp-process-running nil
X  "Boolean indicates whether the ftp process is currently handling
Xan action.")
X
X(defvar ange-ftp-process-status nil
X  "Set to t if an action sent to the ftp process succeeds.")
X
X(defvar ange-ftp-process-multi-skip nil
X  "Set to t while skipping a multi-line reply.")
X
X(defvar ange-ftp-have-read-netrc nil
X  "Boolean indicating whether the user's .netrc file has been read yet.")
X
X(defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable)
X  "Hash table holding associations between HOST, USER pairs.")
X
X(defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
X  "Mapping between a HOST, USER pair and a PASSWORD for it.")
X
X(defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable)
X  "Hash table for storing directories and their respective files.")
X
X;;;; ------------------------------------------------------------
X;;;; Password support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-read-passwd (prompt &optional default)
X  "Read a password from the user. Echos a . for each character typed.
XEnd with RET, LFD, or ESC. DEL or C-h rubs out.  ^U kills line.
XOptional DEFAULT is password to start with."
X  (let ((pass (if default default ""))
X	(c 0)
X	(echo-keystrokes 0)
X	(cursor-in-echo-area t))
X    (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
X      (message "%s%s"
X	       prompt
X	       (make-string (length pass) ?.))
X      (setq c (read-char))
X      (if (= c ?\C-u)
X	  (setq pass "")
X	(if (and (/= c ?\b) (/= c ?\177))
X	    (setq pass (concat pass (char-to-string c)))
X	  (if (> (length pass) 0)
X	      (setq pass (substring pass 0 -1))))))
X    (message "")
X    (substring pass 0 -1)))
X
X(defun ange-ftp-set-user (host user)
X  "For a given HOST, set or change the default USER."
X  (interactive "sHost: \nsUser: ")
X  (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable))
X
X(defun ange-ftp-get-user (host)
X  "Given a HOST, return the default USER."
X  (or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
X  (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable)))
X    (or user
X	(cond ((stringp ange-ftp-default-user)
X	       ;; We have a default name.  Use it.
X	       ange-ftp-default-user)
X	      (ange-ftp-default-user
X	       ;; Ask the user and remember the response.
X	       (let* ((enable-recursive-minibuffers t)
X		      (user (read-string (format "User for %s: " host)
X					 (user-login-name))))
X		 (ange-ftp-set-user host user)
X		 user))
X	      ;; Default to the user's login name.
X	      (t (user-login-name))))))
X
X(defun ange-ftp-set-passwd (host user passwd)
X  "For a given HOST and USER, set or change the associated PASSWD."
X  (interactive (list (read-string "Host: ")
X		     (read-string "User: ")
X		     (ange-ftp-read-passwd "Password: ")))
X  (ange-ftp-put-hash-entry (concat host "/" user)
X			   passwd
X			   ange-ftp-passwd-hashtable))
X
X(defun ange-ftp-get-host-with-passwd (user)
X  "Given a USER, return a host we know the password for."
X  (or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
X  (catch 'found-one
X    (ange-ftp-map-hashtable
X     (function (lambda (host val)
X		 (if (ange-ftp-get-hash-entry (concat host "/" user)
X					      ange-ftp-passwd-hashtable)
X		     (throw 'found-one host))))
X     ange-ftp-user-hashtable)
X    nil))
X
X(defun ange-ftp-get-passwd (host user)
X  "Given a HOST and USER, return the ftp password,
Xprompting if it was not previously set."
X  (or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
X  (let ((passwd (ange-ftp-get-hash-entry (concat host "/" user)
X					 ange-ftp-passwd-hashtable)))
X    (or passwd
X	(and ange-ftp-generate-anonymous-password
X	     (string-equal user "anonymous")
X	     (concat (user-login-name) "@" (system-name)))
X	(let* ((other (ange-ftp-get-host-with-passwd user))
X	       (passwd (if other
X			   (ange-ftp-read-passwd
X			    (format "passwd for %s@%s (same as %s@%s): "
X				    user host user other)
X			    (ange-ftp-get-hash-entry (concat other "/" user)
X						     ange-ftp-passwd-hashtable))
X			 (ange-ftp-read-passwd
X			  (format "Password for %s@%s: " user host)))))
X	  (ange-ftp-set-passwd host user passwd)
X	  passwd))))
X
X;;;; ------------------------------------------------------------
X;;;; ~/.netrc support
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-parse-field (field limit)
X  "Move along current line looking for the value of the FIELD.  Valid
Xseparators between FIELD and its value are commas and whitespace.
XSecond arg LIMIT is a limit for the search."
X  (if (search-forward field limit t)
X      (let (beg)
X	(skip-chars-forward ", \t\r\n" limit)
X	(if (looking-at "\"")		;quoted field value
X	    (progn (forward-char 1)
X		   (setq beg (point))
X		   (skip-chars-forward "^\"" limit)
X		   (forward-char 1)
X		   (buffer-substring beg (1- (point))))
X	  (setq beg (point))
X	  (skip-chars-forward "^, \t\r\n" limit)
X	  (buffer-substring beg (point))))))
X
X(defun ange-ftp-parse-line ()
X  "Extract the values of the fields \`machine\', \`login\' and \`password\'
Xfrom the current line of the buffer.  If successful, call ange-ftp-set-passwd
Xwith the values found."
X  (beginning-of-line)
X  (let ((bol (point))
X	(eol (progn (re-search-forward "machine" (point-max) 'end 2) (point)))
X	machine login password)
X    (goto-char bol)
X    (setq machine (ange-ftp-parse-field "machine" eol)
X	  login (ange-ftp-parse-field "login" eol)
X	  password (ange-ftp-parse-field "password" eol))
X    (and machine login
X	 (progn
X	   (ange-ftp-set-user machine login)
X	   (ange-ftp-set-passwd machine login password)))
X    (goto-char eol)))
X
X(defun ange-ftp-chase-symlinks (file)
X  "Return the filename that FILENAME references, following all symbolic links."
X  (let (temp)
X    (while (setq temp (file-symlink-p file))
X      (setq file
X	    (if (file-name-absolute-p temp)
X		temp
X	      (concat (file-name-directory file) temp)))))
X  file)
X
X(defun ange-ftp-parse-netrc ()
X  "If ~/.netrc file exists and has the correct security then extract the
X\`machine\', \`login\' and \`password\' information from each line." 
X  ;; We set this before actually doing it to avoid the possibility
X  ;; of an infinite loop if ange-ftp-netrc-filename is an ftp file.
X  (setq ange-ftp-have-read-netrc t)
X  (let* ((file (ange-ftp-chase-symlinks (expand-file-name ange-ftp-netrc-filename)))
X	 (attr (file-attributes file)))
X    (if attr				; File exits.
X	(if (and (eq (nth 2 attr) (user-uid)) ; Same uids.
X		 (string-match ".r..------" (nth 8 attr))) ; Readable by user only.
X	    (save-excursion
X	      (set-buffer (generate-new-buffer "*ftp-.netrc*"))
X	      (insert-file-contents file)
X	      (goto-char (point-min))
X	      (while (not (eobp))
X		(ange-ftp-parse-line))
X	      (kill-buffer (current-buffer)))
X	  (message "skipping badly configured .netrc file")))))
X
X;;;; ------------------------------------------------------------
X;;;; Miscellaneous utils.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-ftp-process-buffer (host user)
X  "Return the name of the buffer that collects output from the ftp process
Xconnected to the given HOST and USER pair."
X  (concat "*ftp " user "@" host "*"))
X
X(defun ange-ftp-error (host user msg)
X  "Display the last chunk of output from the ftp process for the given HOST
XUSER pair, and signal an error including MSG in the text."
X  (let ((cur (selected-window))
X	(pop-up-windows t))
X    (pop-to-buffer
X     (get-buffer-create
X      (ange-ftp-ftp-process-buffer host user)))
X    (goto-char (point-max))
X    (select-window cur))
X  (error "ange-ftp: %s" msg))
X
X(defun ange-ftp-set-buffer-mode ()
X  "Set the correct modes for the current buffer if it is visiting a remote
Xfile."
X  (if (and (stringp buffer-file-name)
X	   (ange-ftp-ftp-path buffer-file-name))
X      (progn
X	(auto-save-mode 0)
X	(make-variable-buffer-local 'revert-buffer-function)
X	(setq revert-buffer-function 'ange-ftp-revert-buffer))))
X
X(defun ange-ftp-kill-ftp-process (buffer)
X  "If the BUFFER's visited filename or default-directory is an ftp filename
Xthen kill the related ftp process."
X  (interactive "bKill FTP process associated with buffer: ")
X  (if (null buffer)
X      (setq buffer (current-buffer)))
X  (let ((file (or (buffer-file-name) default-directory)))
X    (if file
X	(let ((parsed (ange-ftp-ftp-path (expand-file-name file))))
X	  (if parsed
X	      (let ((host (nth 0 parsed))
X		    (user (nth 1 parsed)))
X		(kill-buffer (ange-ftp-ftp-process-buffer host user))))))))
X
X
X;;;; ------------------------------------------------------------
X;;;; FTP process filter support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-process-handle-line (line)
X  "Look at the given LINE from the ftp process.  Try to catagorize it
Xinto one of four categories: good, skip, fatal, or unknown."
X  (cond ((string-match ange-ftp-skip-msgs line)
X	 t)
X	((string-match ange-ftp-good-msgs line)
X	 (setq ange-ftp-process-running nil
X	       ange-ftp-process-status t))
X	((string-match ange-ftp-fatal-msgs line)
X	 (delete-process proc)
X	 (setq ange-ftp-process-running nil))
X	((string-match ange-ftp-multi-msgs line)
X	 (setq ange-ftp-process-multi-skip t))
X	(ange-ftp-process-multi-skip
X	 t)
X	(t
X	 (setq ange-ftp-process-running nil))))
X
X(defun ange-ftp-process-log-string (proc str)
X  "For a given PROCESS, log the given STRING at the end of its
Xassociated buffer."
X  (let ((old-buffer (current-buffer)))
X    (unwind-protect
X	(let (moving)
X	  (set-buffer (process-buffer proc))
X	  (setq moving (= (point) (process-mark proc)))
X	  (save-excursion
X	    ;; Insert the text, moving the process-marker.
X	    (goto-char (process-mark proc))
X	    (insert str)
X	    (set-marker (process-mark proc) (point)))
X	  (if moving (goto-char (process-mark proc))))
X      (set-buffer old-buffer))))
X
X(defun ange-ftp-process-filter (proc str)
X  "Build up a complete line of output from the ftp PROCESS and pass it
Xon to ange-ftp-process-handle-line to deal with."
X  (ange-ftp-process-log-string proc str)
X  (if ange-ftp-process-running
X      (progn
X	(setq ange-ftp-process-string (concat ange-ftp-process-string str)))
X    ;; if we gave an empty password to the USER command earlier then we
X    ;; should send a null password now.
X    (if (string-match "Password: *$" ange-ftp-process-string)
X	(send-string proc "\n")))
X  (while (and ange-ftp-process-running
X	      (string-match "\n" ange-ftp-process-string))
X    (let ((line (substring ange-ftp-process-string 0 (match-beginning 0))))
X      (setq ange-ftp-process-string (substring ange-ftp-process-string
X					       (match-end 0)))
X      (while (string-match "^ftp> *" line)
X	(setq line (substring line (match-end 0))))
X      (ange-ftp-process-handle-line line))))
X
X(defun ange-ftp-process-sentinel (proc str)
X  "When ftp process changes state, nuke all file-entries in cache."
X  (let ((name (process-name proc)))
X    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name)
X      (let ((user (substring name (match-beginning 1) (match-end 1)))
X	    (host (substring name (match-beginning 2) (match-end 2))))
X	(ange-ftp-wipe-file-entries host user))))
X  (setq ange-ftp-ls-cache-file nil))
X
X;;;; ------------------------------------------------------------
X;;;; Gateway support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-use-gateway-p (host)
X  (not (string-match ange-ftp-local-host-regexp host)))
X
X(defun ange-ftp-make-tmp-name (host)
X  (make-temp-name (if (ange-ftp-use-gateway-p host)
X		      ange-ftp-gateway-tmp-name-template
X		    ange-ftp-tmp-name-template)))
X
X
X;;;; ------------------------------------------------------------
X;;;; Interactive gateway program support.
X;;;; ------------------------------------------------------------
X
X(defvar ange-ftp-gwp-running t)
X(defvar ange-ftp-gwp-status nil)
X
X(defun ange-ftp-gwp-sentinel (proc str)
X  (setq ange-ftp-gwp-running nil))
X
X(defun ange-ftp-gwp-filter (proc str)
X  (ange-ftp-process-log-string proc str)
X  (cond ((string-match "login: *$" str)
X	 (send-string proc
X		      (concat
X		       (let ((ange-ftp-default-user t))
X			 (ange-ftp-get-user ange-ftp-gateway-host))
X		       "\n")))
X	((string-match "Password: *$" str)
X	 (send-string proc
X		      (concat
X		       (ange-ftp-get-passwd ange-ftp-gateway-host
X					    (ange-ftp-get-user ange-ftp-gateway-host))
X		       "\n")))
X	((string-match "No route to host\\|Connection closed\\|No such host" str)
X	 (delete-process proc)
X	 (setq ange-ftp-gwp-running nil))
X	((string-match ange-ftp-gateway-prompt-pattern str)
X	 (setq ange-ftp-gwp-running nil
X	       ange-ftp-gwp-status t))))
X
X(defun ange-ftp-gwp-start (host user name args)
X  "Login to the gateway machine and fire up an ftp process."
X  (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
X	 (proc (start-process name name 
X			      ange-ftp-gateway-program
X			      ange-ftp-gateway-host))
X	 (ftp (mapconcat (function (lambda (x) x)) args " ")))
X    (process-kill-without-query proc)
X    (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
X    (set-process-filter proc (function ange-ftp-gwp-filter))
X    (set-marker (process-mark proc) (point))
X    (setq ange-ftp-gwp-running t
X	  ange-ftp-gwp-status nil)
X    (message "Connecting to gateway %s..." ange-ftp-gateway-host)
X    (while ange-ftp-gwp-running		;perform login sequence
X      (accept-process-output proc))
X    (if (not ange-ftp-gwp-status)
X	(ange-ftp-error host user "unable to login to gateway"))
X    (message "Connecting to gateway %s...done" ange-ftp-gateway-host)
X    (setq ange-ftp-gwp-running t
X	  ange-ftp-gwp-status nil)
X    (process-send-string proc ange-ftp-gateway-setup-term-command)
X    (while ange-ftp-gwp-running		;zap ^M's and double echoing.
X      (accept-process-output proc))
X    (if (not ange-ftp-gwp-status)
X	(ange-ftp-error host user "unable to set terminal modes on gateway"))
X    (setq ange-ftp-gwp-running t
X	  ange-ftp-gwp-status nil)
X    (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
X    proc))
X
X;;;; ------------------------------------------------------------
X;;;; Support for sending commands to the ftp process.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-raw-send-cmd (proc cmd)
X  "Low-level routine to send the given ftp CMD to the ftp PROCESS.
XReturns non-nil if successful."
X  (if (eq (process-status proc) 'run)
X      (save-excursion
X	(setq ange-ftp-process-string ""
X	      ange-ftp-process-running t
X	      ange-ftp-process-status nil
X	      ange-ftp-process-multi-skip nil
X	      cmd (concat cmd "\n"))
X	(set-buffer (process-buffer proc))
X	(goto-char (point-max))
X	(move-marker last-input-start (point))
X	;; don't insert the password into the buffer on the USER command.
X	(if (string-match "^user \"[^\"]*\"" cmd)
X	    (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
X	  (insert cmd))
X	(move-marker last-input-end (point))
X	(send-string proc cmd)
X	(set-marker (process-mark proc) (point))
X	(while ange-ftp-process-running
X	  (accept-process-output proc))
X	ange-ftp-process-status)))
X
X(defun ange-ftp-start-process (host user name)
X  "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
XIf HOST is only ftp-able through a gateway machine then spawn a shell
Xon the gateway machine to do the ftp instead."
X  (let ((args '("ftp" "-i" "-n" "-g" "-v"))
X	proc)
X    (if (and (ange-ftp-use-gateway-p host)
X	     (not ange-ftp-smart-gateway))
X	(if ange-ftp-gateway-program-interactive
X	    (setq proc (ange-ftp-gwp-start host user name args))
X	  (setq proc (apply 'start-process name name
X			    (append (list ange-ftp-gateway-program
X					  ange-ftp-gateway-host)
X				    args))))
X      (setq proc (apply 'start-process name name args)))
X    (process-kill-without-query proc)
X    (set-process-sentinel proc (function ange-ftp-process-sentinel))
X    (set-process-filter proc (function ange-ftp-process-filter))
X    (save-excursion
X      (set-buffer (process-buffer proc))
X      (ange-ftp-shell-mode))
X    (accept-process-output proc)	;wait for ftp startup message
X    proc))
X
X(defun ange-ftp-quote-passwd (pass)
X  "Return a properly quoted password that is acceptable to the ftp process."
X  (apply (function concat)
X	 (mapcar
X	   (function
X	     (lambda (char)
X		   (vector ?\\ char)))
X	   pass)))
X
X(defun ange-ftp-get-process (host user)
X  "Return the process object for a ftp process connected to HOST and
Xlogged in as USER.  Create a new proces if needed."
X  (let* ((name (ange-ftp-ftp-process-buffer host user))
X	 (proc (get-process name)))
X    (if (and proc (eq (process-status proc) 'run))
X	proc
X      (let ((pass (ange-ftp-quote-passwd
X		   (ange-ftp-get-passwd host user))))
X	(setq proc (ange-ftp-start-process host user name))
X	(if (and ange-ftp-smart-gateway
X		 (ange-ftp-use-gateway-p host))
X	    (progn
X	      (message "Opening FTP connection to %s via %s..." host
X		       ange-ftp-gateway-host)
X	      (or (ange-ftp-raw-send-cmd proc
X					 (format "open %s %s"
X						 ange-ftp-gateway-host
X						 ange-ftp-smart-gateway-port))
X		  (ange-ftp-error host user "OPEN request failed"))
X	      (message "Logging in as user %s@%s..." user host)
X	      (or (ange-ftp-raw-send-cmd proc (format "user \"%s\"@%s %s"
X						      user host pass))
X		  (progn
X		    (ange-ftp-set-passwd host user nil) ;reset password.
X		    (ange-ftp-error host user "USER request failed")))
X	      (message "Logging in as user %s@%s...done" user host))
X	  (message "Opening FTP connection to %s..." host)
X	  (or (ange-ftp-raw-send-cmd proc (format "open %s" host))
X	      (ange-ftp-error host user "OPEN request failed"))
X	  (message "Logging in as user %s@%s..." user host)
X	  (or (ange-ftp-raw-send-cmd proc (format "user \"%s\" %s" user pass))
X	      (progn
X		(ange-ftp-set-passwd host user nil) ;reset password.
X		(ange-ftp-error host user "USER request failed")))
X	  (message "Logging in as user %s@%s...done" user host))
X	proc))))
X
X(defun ange-ftp-send-cmd (host user cmd)
X  "Find an ftp process connected to HOST logged in as USER and send it CMD.
XReturns whether successful."
X  (let ((proc (ange-ftp-get-process host user)))
X    (or (ange-ftp-raw-send-cmd proc cmd)
X	;; Failed, try once more.
X	(and (setq proc (ange-ftp-get-process host user))
X	     (ange-ftp-raw-send-cmd proc cmd)))))
X
X;;;; ------------------------------------------------------------
X;;;; Simple FTP process shell support.
X;;;; ------------------------------------------------------------
X
X(require 'shell)
X
X(defvar ange-ftp-shell-mode-map nil)
X
X(defun ange-ftp-shell-mode ()
X  "Major mode for interacting with an FTP process.
XReturn at end of buffer sends line as input.
XReturn not at end copies rest of line to end and sends it.
X
XThe following commands imitate the usual Unix interrupt and editing
Xcontrol characters:
X\\{ange-ftp-shell-mode-map}
XRuns ange-ftp-shell-mode-hook if not nil."
X  (interactive)
X  (let ((proc (get-buffer-process (current-buffer))))
X    (kill-all-local-variables)
X    (if (not ange-ftp-shell-mode-map)
X	(progn
X	  (setq ange-ftp-shell-mode-map (copy-keymap shell-mode-map))
X	  (define-key ange-ftp-shell-mode-map "\C-m" 'ange-ftp-shell-send-input)))
X    (use-local-map ange-ftp-shell-mode-map)
X    (setq major-mode 'ange-ftp-shell-mode)
X    (setq mode-name "ange-ftp")
X    (setq mode-line-process '(": %s"))
X    (make-local-variable 'last-input-start)
X    (setq last-input-start (make-marker))
X    (make-local-variable 'last-input-end)
X    (setq last-input-end (make-marker))
X    (goto-char (point-max))
X    (set-marker (process-mark proc) (point))
X    (run-hooks 'ange-ftp-shell-mode-hook)))
X
X(defun ange-ftp-shell-send-input ()
X  "Send input to FTP process.
XAt end of buffer, sends all text after last output as input to the subshell,
Xincluding a newline inserted at the end.  When not at end, copies current line
Xto the end of the buffer and sends it, after first attempting to discard any
Xprompt at the beginning of the line."
X  (interactive)
X  (let ((process (get-buffer-process (current-buffer))))
X    (or process
X	(error "Current buffer has no process"))
X    (end-of-line)
X    (if (eobp)
X	(progn
X	  (move-marker last-input-start
X		       (process-mark process))
X	  (insert ?\n)
X	  (move-marker last-input-end (point)))
X      (beginning-of-line)
X      (re-search-forward "ftp> *"
X			 (save-excursion (end-of-line) (point))
X			 t)
X      (let ((copy (buffer-substring (point)
X				    (progn (forward-line 1) (point)))))
X	(goto-char (point-max))
X	(move-marker last-input-start (point))
X	(insert copy)
X	(move-marker last-input-end (point))))
X    (process-send-region process last-input-start last-input-end)
X    (set-marker (process-mark process) (point))))
X
X;;;; ------------------------------------------------------------
X;;;; Remote pathname syntax support.
X;;;; ------------------------------------------------------------
X
X(defmacro ange-ftp-ftp-path-component (n)
X  "Extract the Nth ftp path component."
X  (` (let ((elt (nth (, n) ns)))
X       (substring path (match-beginning elt) (match-end elt)))))
X
X(defun ange-ftp-ftp-path (path)
X  "Parse PATH according to ange-ftp-path-format (which see).
XReturns a list (HOST USER PATH), or nil if PATH does not match the format."
X  (let ((data (match-data)))
X    (unwind-protect
X	(if (string-match (car ange-ftp-path-format) path)
X	    (let* ((ns (cdr ange-ftp-path-format))
X		   (host (ange-ftp-ftp-path-component 0))
X		   (user (ange-ftp-ftp-path-component 1))
X		   (path (ange-ftp-ftp-path-component 2)))
X	      (if (zerop (length user))
X		  (setq user (ange-ftp-get-user host)))
X	      (list host user path))
X	  nil)
X      (store-match-data data))))
X
X(defun ange-ftp-replace-path-component (fullpath path)
X  "Take a FULLPATH that matches according to ange-ftp-path-format and
Xreplace the path component with PATH."
X  (if (string-match (car ange-ftp-path-format) fullpath)
X      (let* ((ns (cdr ange-ftp-path-format))
X	     (elt (nth 2 ns)))
X	(concat (substring fullpath 0 (match-beginning elt))
X		path
X		(substring fullpath (match-end elt))))))
X
X;;;; ------------------------------------------------------------
X;;;; Remote file and directory listing support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-dumb-host (host)
X  "Returns whether HOST's ftp daemon doesn't like \'ls\' or \'dir\' commands
Xto take switch arguments."
X  (and ange-ftp-dumb-host-regexp
X       (string-match ange-ftp-dumb-host-regexp host)))
X
X(defun ange-ftp-add-dumb-host (host)
X  "Interactively adds a given HOST to ange-ftp-dumb-host-regexp."
X  (interactive "sHost: ")
X  (if (not (ange-ftp-dumb-host host))
X      (setq ange-ftp-dumb-host-regexp
X	    (concat "^" (regexp-quote host) "$\\|"
X		    ange-ftp-dumb-host-regexp))))
X
X(defvar ange-ftp-ls-cache-cmd nil
X  "Last `ls' command issued by ange-ftp-ls.")
X
X(defvar ange-ftp-ls-cache-file nil
X  "Last file passed to ange-ftp-ls.")
X
X(defvar ange-ftp-ls-cache-res nil
X  "Last result returned from ange-ftp-ls.")
X
X(defun ange-ftp-ls (file lsargs &optional want-buffer)
X  "Return the output of an `ls' command done on a remote machine using ftp.
XThe first argument FILE is the full name of the remote file, the second arg
XLSARGS is any args to pass to the `ls' command, and the optional third arg
XWANT-BUFFER indicates that a buffer object should be returned rather than
Xa string object."
X  (let ((parsed (ange-ftp-ftp-path file)))
X    (if parsed
X	(let* ((host (nth 0 parsed))
X	       (user (nth 1 parsed))
X	       (path (nth 2 parsed))
X	       (temp (ange-ftp-make-tmp-name host))
X	       lscmd)
X	  (if (string-equal path "")
X	      (setq path "."))
X	  (if (ange-ftp-dumb-host host)
X	      (setq lscmd (concat "dir " path " " temp))
X	    (if ange-ftp-ls-follow-symbolic-links
X		(if (> (length lsargs) 0)
X		    (setq lsargs (concat lsargs "L"))
X		  (setq lsargs "-L")))
X	    (setq lscmd (format "ls \"%s %s\" %s" lsargs path temp)))
X	  (if (and ange-ftp-ls-cache-file
X		   (string-equal file ange-ftp-ls-cache-file)
X		   (string-equal lscmd ange-ftp-ls-cache-cmd))
X	      (if (not want-buffer)
X		  ange-ftp-ls-cache-res
X		(set-buffer (get-buffer-create ange-ftp-data-buffer-name))
X		(erase-buffer)
X		(insert ange-ftp-ls-cache-res))
X	    (message "Listing %s..." file)
X	    (if (ange-ftp-send-cmd host user lscmd)
X		(let (data)
X		  (save-excursion
X		    (set-buffer (get-buffer-create ange-ftp-data-buffer-name))
X		    (erase-buffer)
X		    (if (file-readable-p temp)
X			(insert-file-contents temp)
X		      (ange-ftp-error host user
X				      (format "list data file %s not readable"
X					      temp)))
X		    (setq ange-ftp-ls-cache-file file
X			  ange-ftp-ls-cache-cmd lscmd
X			  ange-ftp-ls-cache-res (buffer-string))
X		    (if want-buffer
X			(setq data (current-buffer))
X		      (setq data ange-ftp-ls-cache-res)
X		      (kill-buffer (current-buffer)))
X		    (condition-case () (delete-file temp) (error nil)))
X		  (message "Listing %s...done" file)
X		  data)
X	      (ange-ftp-error host user "Unable to get a remote ls")))))))
X
X;;;; ------------------------------------------------------------
X;;;; Directory information caching support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-parse-filename ()
X  "Extract the filename from the current line of a dired-like listing."
X  (save-excursion
X    (let ((eol (progn (end-of-line) (point))))
X      (beginning-of-line)
X      (if (re-search-forward
X	   "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
X	   eol t)
X	  (progn (skip-chars-forward " ")
X		 (skip-chars-forward "^ " eol)
X		 (skip-chars-forward " " eol)
X		 (let ((beg (point)))
X		   (skip-chars-forward "^ \n")
X;;	           (skip-chars-backward "*/@")
X		   (buffer-substring beg (point))))))))
X
X(defun ange-ftp-parse-dired-listing ()
X  "Parse the current buffer which is assumed to be in a dired-like listing
Xformat, and return a hashtable as the result."
X  (let ((tbl (ange-ftp-make-hashtable)))
X    (goto-char (point-min))
X    (if (re-search-forward "total [0-9]+" nil t) ;total not always first line.
X	(progn
X	  (forward-line 1)			;Skip over total byte count.
X	  (let (file)
X	    (while (setq file (ange-ftp-parse-filename))
X	      (beginning-of-line)
X;;	      (skip-chars-forward "\t 0-9")
X	      (ange-ftp-put-hash-entry file (looking-at "d") tbl)
X	      (forward-line 1)))
X	  (ange-ftp-put-hash-entry "." t tbl)
X	  (ange-ftp-put-hash-entry ".." t tbl)))
X    tbl))
X
X(defun ange-ftp-set-files (directory files)
X  "For a given DIRECTORY, set or change the associated FILES hashtable."
X  (ange-ftp-put-hash-entry directory files ange-ftp-files-hashtable))
X
X(defun ange-ftp-get-files (directory)
X  "Given a given DIRECTORY, return a hashtable of file entries."
X  (setq directory (file-name-as-directory directory)) ;normalize
X  (let ((files (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)))
X    (or files
X	(save-excursion
X	  (set-buffer (ange-ftp-ls directory "-al" t))
X	  (let ((files (ange-ftp-parse-dired-listing)))
X	    (ange-ftp-put-hash-entry directory
X				     files
X				     ange-ftp-files-hashtable)
X	    (kill-buffer (current-buffer))
X	    files)))))
X
X(defmacro ange-ftp-get-file-part (path)
X  "Given PATH, return the file part that can be used for looking up the file's
Xentry in a hashtable."
X  (` (let ((file (file-name-nondirectory (, path))))
X       (if (string-equal file "")
X	   "."
X	 file))))
X
X(defun ange-ftp-get-file-entry (path)
X  "Given PATH, return whether the given file entry.  At the moment
Xthis returns whether PATH is a directory or not."
X  (ange-ftp-get-hash-entry (ange-ftp-get-file-part path)
X			   (ange-ftp-get-files (file-name-directory path))))
X
X(defun ange-ftp-file-entry-p (path)
X  "Given PATH, return whether there is a file entry for it."
X  (ange-ftp-hash-entry-exists-p (ange-ftp-get-file-part path)
X				(ange-ftp-get-files (file-name-directory path))))
X
X(defun ange-ftp-delete-file-entry (path)
X  "Given a PATH, delete the file entry for it, if it exists."
X  (let ((files (ange-ftp-get-hash-entry (file-name-directory path)
X					ange-ftp-files-hashtable)))
X    (if files
X	(ange-ftp-del-hash-entry (ange-ftp-get-file-part path)
X				 files)))
X  (setq ange-ftp-ls-cache-file nil))
X
X(defun ange-ftp-add-file-entry (path &optional dir-p)
X  "Given a PATH, add the file entry for it, if its directory info exists."
X  (let ((files (ange-ftp-get-hash-entry (file-name-directory path)
X					ange-ftp-files-hashtable)))
X    (if files
X	(ange-ftp-put-hash-entry (ange-ftp-get-file-part path)
X				 dir-p
X				 files)))
X  (setq ange-ftp-ls-cache-file nil))
X
X(defun ange-ftp-wipe-file-entries (host user)
X  "Remove all file entry information for the given HOST, USER pair."
X  (ange-ftp-map-hashtable
X   (function
X    (lambda (key val)
X      (let ((parsed (ange-ftp-ftp-path key)))
X	(if parsed
X	    (let ((h (nth 0 parsed))
X		  (u (nth 1 parsed)))
X	      (if (and (equal host h) (equal user u))
X		  (ange-ftp-del-hash-entry key
X					   ange-ftp-files-hashtable)))))))
X   ange-ftp-files-hashtable))
X
X;;;; ------------------------------------------------------------
X;;;; File transfer mode support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-set-binary-mode (host user)
X  "Tell the ftp process for the given HOST & USER to switch to binary mode."
X  (ange-ftp-send-cmd host user "type binary"))
X
X(defun ange-ftp-set-ascii-mode (host user)
X  "Tell the ftp process for the given HOST & USER to switch to ascii mode."
X  (ange-ftp-send-cmd host user "type ascii"))
X
X;;;; ------------------------------------------------------------
X;;;; Redefinitions of standard GNU Emacs functions.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-canonize-filename (n)
X  "Take a list of characters and short-circuit //, /. and /.."
X  (if (string-match "//" n)
X      (setq n (substring n (1- (match-end 0)))))
X  (while (cond ((string-match "/\\./\\|/\\.$" n)
X		(setq n (concat (substring n 0 (match-beginning 0))
X				(substring n (+ 2 (match-beginning 0))))))
X	       ((string-match "/[^/]+/\\.\\.\\(/\\|$\\)" n)
X		(let ((end (match-end 0))
X		      (beg (match-beginning 0))
X		      (slash (= (match-beginning 1) (match-end 1))))
X		  (if (or (and (zerop beg) (not slash))
X			  (and (not (zerop beg)) slash))
X		      (setq end (1- end)))
X		  (setq n (concat (substring n 0 (1+ beg))
X				  (substring n end)))))))
X  n)
X
X(defun ange-ftp-expand-file-name (name &optional default)
X  "Convert FILENAME to absolute, and canonicalize it.
XSecond arg DEFAULT is directory to start with if FILENAME is relative
X \(does not start with slash\); if DEFAULT is nil or missing,
Xthe current buffer's value of default-directory is used.
XFilenames containing . or .. as components are simplified;
Xinitial ~ is expanded.  See also the function  substitute-in-file-name.
X
XNote that this function has been extended to deal with remote filename syntax."
X  (let (lose)
X    (if (string-match "^/" name)
X	(progn
X	  (while (cond ((string-match "//" name)
X			(setq name (substring name (1- (match-end 0)))))
X		       ((string-match "/~" name)
X			(setq name (substring name (1- (match-end 0)))
X			      lose t))))
X	  (setq lose
X		(or lose
X		    (string-match "/\\./\\|/\\.$\\|/\\.\\./\\|/\\.\\.$" name))))
X      (setq lose t))
X    (if lose
X	(if (string-match "^~" name)
X	    (ange-ftp-real-expand-file-name name)
X	  (if (string-match "^/" name)
X	      (ange-ftp-canonize-filename name)
X	    (ange-ftp-canonize-filename
X	     (concat (file-name-as-directory (or default default-directory))
X			  name))))
X      name)))
X
X(defun ange-ftp-file-name-as-directory (name)
X  "Return a string representing file FILENAME interpreted as a directory.
XThis string can be used as the value of default-directory
Xor passed as second argument to expand-file-name.
XFor a Unix-syntax file name, just appends a slash.
XOn VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.
X
XNote that this function has been extended to deal with remote filename syntax."
X  (let ((parsed (ange-ftp-ftp-path name)))
X    (if (and parsed (string-equal (nth 2 parsed) ""))
X	name
X      (ange-ftp-real-file-name-as-directory name))))
X	
X(defun ange-ftp-file-name-directory (name)
X  "Return the directory component in file name NAME.
XReturn nil if NAME does not include a directory.
XOtherwise returns a directory spec.
XGiven a Unix syntax file name, returns a string ending in slash;
Xon VMS, perhaps instead a string ending in :, ] or >.
X
XNote that this function has been extended to deal with remote filename syntax."
X  (let ((parsed (ange-ftp-ftp-path name)))
X    (if parsed
X	(let ((path (nth 2 parsed)))
X	  (if (string-match "^~[^/]*$" path)
X	      name
X	    (ange-ftp-replace-path-component
X	        name
X		(ange-ftp-real-file-name-directory path))))
X      (ange-ftp-real-file-name-directory name))))
X
X(defun ange-ftp-file-name-nondirectory (name)
X  "Return file name NAME sans its directory.
XFor example, in a Unix-syntax file name,
Xthis is everything after the last slash,
Xor the entire name if it contains no slash.
X
XNote that this function has been extended to deal with remote filename syntax."
X  (let ((parsed (ange-ftp-ftp-path name)))
X    (if parsed
X	(let ((path (nth 2 parsed)))
X	  (if (string-match "^~[^/]*$" path)
X	      ""
X	    (ange-ftp-real-file-name-nondirectory path)))
X      (ange-ftp-real-file-name-nondirectory name))))
X
X(defun ange-ftp-directory-file-name (dir)
X  "Returns the file name of the directory named DIR.
XThis is the name of the file that holds the data for the directory DIR.
XIn Unix-syntax, this just removes the final slash.
XOn VMS, given a VMS-syntax directory name such as \"[X.Y]\",
Xreturns a file name such as \"[X]Y.DIR.1\".
X
XNote that this function has been extended to deal with remote filename syntax."
X  (let ((parsed (ange-ftp-ftp-path dir)))
X    (if parsed
X	(ange-ftp-replace-path-component
X	   dir
X	   (ange-ftp-real-directory-file-name (nth 2 parsed)))
X      (ange-ftp-real-directory-file-name dir))))
X
X(defun ange-ftp-binary-file (file)
X  "Returns whether the given FILE is to be considered as a binary file for
Xftp transfers."
X  (string-match ange-ftp-binary-file-name-regexp file))
X
X(defun ange-ftp-write-region (start end filename &optional append visit)
X  "Write current region into specified file.
XWhen called from a program, takes three arguments:
XSTART, END and FILENAME.  START and END are buffer positions.
XOptional fourth argument APPEND if non-nil means
X  append to existing file contents (if any).
XOptional fifth argument VISIT if t means
X  set last-save-file-modtime of buffer to this file's modtime
X  and mark buffer not modified.
XIf VISIT is neither t nor nil, it means do not print
X  the \"Wrote file\" message.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (interactive "r\nFWrite region to file: ")
X  (setq filename (expand-file-name filename))
X  (let ((parsed (ange-ftp-ftp-path filename)))
X    (if parsed
X	(let* ((host (nth 0 parsed))
X	       (user (nth 1 parsed))
X	       (path (nth 2 parsed))
X	       (temp (ange-ftp-make-tmp-name host))
X	       (binary (ange-ftp-binary-file filename))
X	       (cmd (if append "append" "put")))
X	  (ange-ftp-real-write-region start end temp nil 'nomsg)
X	  (message "Writing %s..." filename)
X	  (unwind-protect
X	      (progn
X		(if binary
X		    (ange-ftp-set-binary-mode host user))
X		(or (ange-ftp-send-cmd host user
X				       (format "%s %s %s" cmd temp path))
X		    (signal 'file-error
X			    (list
X			     "Opening output file"
X			     (format "Unable to %s remote file" (upcase cmd))
X			     filename))))
X	    (delete-file temp)
X	    (if binary 
X		(ange-ftp-set-ascii-mode host user)))
X	  (if (eq visit t)
X	      (progn
X		(ange-ftp-set-buffer-mode)
X		(setq buffer-file-name filename)
X		(set-buffer-modified-p nil)))
X	  (message "Wrote %s" filename)
X	  (ange-ftp-add-file-entry filename))
X      (ange-ftp-real-write-region start end filename append visit))))
X
X(defun ange-ftp-insert-file-contents (filename &optional visit)
X  "Insert contents of file FILENAME after point.
XReturns list of absolute pathname and length of data inserted.
XIf second argument VISIT is non-nil, the buffer's visited filename
Xand last save file modtime are set, and it is marked unmodified.
XIf visiting and the file does not exist, visiting is completed
Xbefore the error is signaled.
X
XNote this function has been extended to deal with remote files using ftp."
X  (barf-if-buffer-read-only)
X  (setq filename (expand-file-name filename))
X  (let ((parsed (ange-ftp-ftp-path filename)))
X    (if parsed
X	(let* ((host (nth 0 parsed))
X	       (user (nth 1 parsed))
X	       (path (nth 2 parsed))
X	       (temp (ange-ftp-make-tmp-name host))
X	       (binary (ange-ftp-binary-file filename))
X	       result)
X	  (if visit
X	      (setq buffer-file-name filename))
X	  (unwind-protect
X	      (progn
X		(if binary
X		    (ange-ftp-set-binary-mode host user))
X		(message "Retrieving %s..." filename)
X		(or (ange-ftp-send-cmd host user
X				       (format "get %s %s" path temp))
X		    (signal 'file-error
X			    (list
X			     "Opening input file"
X			     "Unable to GET remote file"
X			     filename)))
X		(setq result (ange-ftp-real-insert-file-contents temp visit))
X		(message "Retrieving %s...done" filename))
X	    (condition-case () (delete-file temp) (error nil))
X	    (if binary
X		(ange-ftp-set-ascii-mode host user)))
X	  (if visit
X	      (setq buffer-file-name filename))
X	  result)
X      (ange-ftp-real-insert-file-contents filename visit))))
X
X(defun ange-ftp-revert-buffer (arg noconfirm)
X  "Revert this buffer from a remote file using ftp."
X  (let ((opoint (point)))
X    (cond ((null buffer-file-name)
X	   (error "Buffer does not seem to be associated with any file"))
X	  ((or noconfirm
X	       (yes-or-no-p (format "Revert buffer from file %s? "
X				    buffer-file-name)))
X	   (let ((buffer-read-only nil))
X	     ;; Set buffer-file-name to nil
X	     ;; so that we don't try to lock the file.
X	     (let ((buffer-file-name nil))
X	       (unlock-buffer)
X	       (erase-buffer))
X	     (insert-file-contents buffer-file-name t))
X	   (goto-char (min opoint (point-max)))
X	   (after-find-file nil)
X	   t))))
X
X(defun ange-ftp-file-exists-p (file)
X  "Return t if FILE exists."
X  (setq file (expand-file-name file))
X  (if (ange-ftp-ftp-path file)
X      (ange-ftp-file-entry-p file)
X    (ange-ftp-real-file-exists-p file)))
X
X(defun ange-ftp-file-directory-p (file)
X  "Return t if FILENAME is the name of a directory as a file.
XA directory name spec may be given instead; then the value is t
Xif the directory so specified exists and really is a directory.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (setq file (expand-file-name file))
X  (if (ange-ftp-ftp-path file)
X      (ange-ftp-get-file-entry file)
X    (ange-ftp-real-file-directory-p file)))
X
X(defun ange-ftp-directory-files (directory &optional full match)
X  "Return a list of names of files in DIRECTORY.
XIf FULL is non-NIL, absolute pathnames of the files are returned.
XIf MATCH is non-NIL, only pathnames containing that regexp are returned.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (setq directory (expand-file-name directory))
X  (if (ange-ftp-ftp-path directory)
X      (let (files)
X	(setq directory (file-name-as-directory directory))
X	(mapcar (function
X		 (lambda (f)
X		   (if full
X		       (setq f (concat directory f)))
X		   (if match
X		       (if (string-match match f)
X			   (setq files (cons f files)))
X		     (setq files (cons f files)))))
X		(ange-ftp-hash-table-keys (ange-ftp-get-files directory)))
X	(nreverse files))
X    (ange-ftp-real-directory-files directory full match)))
X
X(defun ange-ftp-file-attributes (file)
X  "Return a list of attributes of file FILENAME.
XValue is nil if specified file cannot be opened.
XOtherwise, list elements are:
X 0. t for directory, string (name linked to) for symbolic link, or nil.
X 1. Number of links to file.
X 2. File uid.
X 3. File gid.
X 4. Last access time, as a list of two integers.
X  First integer has high-order 16 bits of time, second has low 16 bits.
X 5. Last modification time, likewise.
X 6. Last status change time, likewise.
X 7. Size in bytes.
X 8. File modes, as a string of ten letters or dashes as in ls -l.
X 9. t iff file's gid would change if file were deleted and recreated.
X10. inode number.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (setq file (expand-file-name file))
X  (let ((parsed (ange-ftp-ftp-path file)))
X    (if parsed
X	(if (ange-ftp-file-entry-p file)
X	    (let ((host (nth 0 parsed))
X		  (user (nth 1 parsed))
X		  (path (nth 2 parsed)))
X	      (list (ange-ftp-get-file-entry file) ;0
X		    -1			           ;1
X		    -1				   ;2
X		    -1				   ;3
X		    '(0 0)		           ;4
X		    '(0 0)			   ;5
X		    '(0 0)			   ;6
X		    -1				   ;7
X		    "??????????"		   ;8
X		    nil				   ;9
X		    ;; Hack to give remote files a unique "inode number".
X		    ;; It's actually the sum of the characters in its name.
X		    (apply '+ (nconc (mapcar 'identity host)
X				     (mapcar 'identity user)
X				     (mapcar 'identity path))))))
X      (ange-ftp-real-file-attributes file))))
X
X(defun ange-ftp-file-writable-p (file)
X  "Return t if file FILENAME can be written or created by you.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (setq file (expand-file-name file))
X  (or (ange-ftp-ftp-path file)
X      (ange-ftp-real-file-writable-p file)))
X
X(defun ange-ftp-file-readable-p (file)
X  "Return t if file FILENAME exists and can be read by you.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (setq file (expand-file-name file))
X  (if (ange-ftp-ftp-path file)
X      (ange-ftp-file-entry-p file)
X    (ange-ftp-real-file-readable-p file)))
X
X(defun ange-ftp-delete-file (file)
X  "Delete specified file.  One argument, a file name string.
XIf file has multiple names, it continues to exist with the other names.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (interactive "fDelete file: ")
X  (setq file (expand-file-name file))
X  (let ((parsed (ange-ftp-ftp-path file)))
X    (if parsed
X	(let ((host (nth 0 parsed))
X	      (user (nth 1 parsed))
X	      (path (nth 2 parsed)))
X	  (message "Deleting %s..." file)
X	  (or (ange-ftp-send-cmd host user (concat "delete " path))
X	      (signal 'file-error
X		      (list
X		       "Removing old name"
X		       "Unable to execute remote DELETE command"
X		       path)))
X	  (message "Deleting %s...done" file)
X	  (ange-ftp-delete-file-entry file))
X      (ange-ftp-real-delete-file file))))
X
X(defun ange-ftp-verify-visited-file-modtime (buf)
X  "Return t if last mod time of BUF's visited file matches what BUF records.
XThis means that the file has not been changed since it was visited or saved.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (let ((name (buffer-file-name buf)))
X    (if (and (stringp name) (ange-ftp-ftp-path name))
X	t
X      (ange-ftp-real-verify-visited-file-modtime buf))))
X
X(defun ange-ftp-backup-buffer ()
X  "Make a backup of the disk file visited by the current buffer, if appropriate.
XThis is normally done before saving the buffer the first time.
XIf the value is non-nil, it is the result of `file-modes' on the original file;
Xthis means that the caller, after saving the buffer, should change the modes
Xof the new file to agree with the old modes.
X
XNote that this function has been extended to deal with remote files using ftp."
X  (if (and (stringp buffer-file-name) (ange-ftp-ftp-path buffer-file-name))
X      nil
X    (ange-ftp-real-backup-buffer)))
X
X;;;; ------------------------------------------------------------
X;;;; File copying support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
X  (if (file-exists-p absname)
X      (if (not interactive)
X	  (signal 'file-already-exists (list absname))
X	(if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
X				      absname querystring)))
X	    (signal 'file-already-exists (list absname))))))
X
X(defun ange-ftp-copy-remote-to-local (remote local parsed binary)
X  "Copy REMOTE file to LOCAL file, where the former is on a remote machine."
X  (let ((host (nth 0 parsed))
X	(user (nth 1 parsed))
X	(path (nth 2 parsed))
X	temp
X	cmd)
X    (if (or ange-ftp-smart-gateway 
X	    (not (ange-ftp-use-gateway-p host)))
X	(setq cmd (format "get %s %s" path local))
X      (setq temp (ange-ftp-make-tmp-name host))
X      (setq cmd (format "get %s %s" path temp)))
X    (unwind-protect
X	(progn
X	  (if binary
X	      (ange-ftp-set-binary-mode host user))
X	  (message "Copying %s to %s..." remote local)
X	  (or (ange-ftp-send-cmd host user cmd)
X	      (signal 'file-error
X		      (list
X		       "Opening output file"
X		       "Unable to GET remote file"
X		       remote)))
X	  (if temp (copy-file temp local t))
X	  (message "Copying %s to %s...done" remote local))
X      (if binary
X	  (ange-ftp-set-ascii-mode host user))
X      (if temp (delete-file temp)))))
X
X(defun ange-ftp-copy-local-to-remote (local remote parsed binary)
X  "Copy LOCAL file to REMOTE file where the latter is a file on a remote machine."
X  (let ((host (nth 0 parsed))
X	(user (nth 1 parsed))
X	(path (nth 2 parsed))
X	temp
X	cmd)
X    (if (or ange-ftp-smart-gateway
X	    (not (ange-ftp-use-gateway-p host)))
X	(setq cmd (format "put %s %s" local path))
X      (setq temp (ange-ftp-make-tmp-name host))
X      (setq cmd (format "put %s %s" temp path)))
X    (unwind-protect
X	(progn
X	  (if binary
X	      (ange-ftp-set-binary-mode host user))
X	  (message "Copying %s to %s..." local remote)
X	  (if temp (copy-file local temp t))
X	  (or (ange-ftp-send-cmd host user cmd)
X	      (signal 'file-error
X		      (list
X		       "Opening output file"
X		       "Unable to PUT remote file"
X		       remote)))
X	  (message "Copying %s to %s...done" local remote))
X      (if binary
X	  (ange-ftp-set-ascii-mode host user))
X      (if temp (delete-file temp)))
X    (ange-ftp-add-file-entry remote)))
X
X(defun ange-ftp-copy-remote-to-remote (f-file t-file f-parsed t-parsed binary)
X  "Copy F-FILE to T-FILE, where both files are on remote machines."
X  (let ((temp (make-temp-name ange-ftp-copy-tmp-name-template)))
X    (unwind-protect
X	(progn
X	  (ange-ftp-copy-remote-to-local f-file temp f-parsed binary)
X	  (ange-ftp-copy-local-to-remote temp t-file t-parsed binary))
X      (delete-file temp))))
X
X(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
X				    keep-date)
X  "Copy FILE to NEWNAME.  Both args strings.
XSignals a  file-already-exists  error if NEWNAME already exists,
Xunless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
XA number as third arg means request confirmation if NEWNAME already exists.
XThis is what happens in interactive use with M-x.
XFourth arg non-nil means give the new file the same last-modified time
Xthat the old one has.  (This works on only some systems.)
X
XNote this function has been extended to deal with remote files using ftp."
X  (interactive "fCopy file: \nFCopy %s to file: \np")
X  (setq filename (expand-file-name filename)
X	newname (expand-file-name newname))
X  (let ((f-parsed (ange-ftp-ftp-path filename))
X	(t-parsed (ange-ftp-ftp-path newname))
X	(binary (ange-ftp-binary-file filename)))
X    (if (and (or f-parsed t-parsed)
X	     (or (not ok-if-already-exists)
X		 (numberp ok-if-already-exists)))
X	(ange-ftp-barf-or-query-if-file-exists newname "copy to it"
X					       (numberp ok-if-already-exists)))
X    (if f-parsed
X	(if t-parsed
X	    (ange-ftp-copy-remote-to-remote filename newname
X					    f-parsed t-parsed binary)
X	  (ange-ftp-copy-remote-to-local filename newname f-parsed binary))
X      (if t-parsed
X	  (ange-ftp-copy-local-to-remote filename newname t-parsed binary)
X	(ange-ftp-real-copy-file filename newname ok-if-already-exists keep-date)))))
X
X;;;; ------------------------------------------------------------
X;;;; Simple Dired support.
X;;;; ------------------------------------------------------------
X
X(require 'dired)
X
X(defun ange-ftp-dired-readin (dirname buffer)
X  "Emulation of dired-readin with support for remote files using ftp."
X  (save-excursion
X    (message "Reading directory %s..." dirname)
X    (set-buffer buffer)
X    (let ((buffer-read-only nil))
X      (widen)
X      (erase-buffer)
X      (setq dirname (expand-file-name dirname))
X      (if (ange-ftp-ftp-path dirname)
X	  (progn (insert (ange-ftp-ls dirname dired-listing-switches))
X		 (ange-ftp-set-files dirname (ange-ftp-parse-dired-listing)))
X	(if (file-directory-p dirname)
X	    (call-process "ls" nil buffer nil
X			  dired-listing-switches dirname)
X	  (let ((default-directory (file-name-directory dirname)))
X	    (call-process shell-file-name nil buffer nil
X			  "-c" (concat "ls " dired-listing-switches " "
X				       (file-name-nondirectory dirname))))))
X      (goto-char (point-min))
X      (while (not (eobp))
X	(insert "  ")
X	(forward-line 1))
X      (goto-char (point-min))))
X  (message "Reading directory %s...done" dirname))
X
X;;;; ------------------------------------------------------------
X;;;; File name completion support.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-get-files-for-completion (dir)
X  "Return a list of files in the given directory.  Each filename is wrapped
Xin a singleton list and has a trailing slash if it is a directory."
X  (let (res)
X    (ange-ftp-map-hashtable
X     (function (lambda (key val)
X		 (setq res (cons (list (if val
X					   (concat key "/")
X					 key))
X				 res))))
X     (ange-ftp-get-files dir))
X    (or res '(()))))
X
X(defun ange-ftp-file-name-all-completions (file dir)
X  "Return a list of all completions of file name FILE in directory DIR."
X  (if (ange-ftp-ftp-path dir)
X      (all-completions file (ange-ftp-get-files-for-completion dir))
X    (file-name-all-completions file dir)))
X
X(defun ange-ftp-file-name-completion (file dir)
X  "Complete file name FILE in directory DIR.
XReturns the longest string common to all filenames in DIR that start with FILE.
XIf there is only one and FILE matches it exactly, returns t.
XReturns nil if DIR contains no name starting with FILE."
X  (if (ange-ftp-ftp-path dir)
X      (try-completion file (ange-ftp-get-files-for-completion dir))
X    (file-name-completion file dir)))
X
X(defun ange-ftp-quote-filename (file)
X  "Quote $ as $$ to get it past substitute-in-file-name."
X  (apply (function concat)
X	 (mapcar (function
X		   (lambda (char)
X		     (if (= char ?$)
X			 "$$"
X			 (vector char))))
X		 file)))
X
X(defun ange-ftp-read-file-name-internal (string dir action)
X  "Emulates read-file-name-internal for ftp."
X  (let (name realdir)
X    (if (eq action 'lambda)
X	(if (> (length string) 0)
X	    (ange-ftp-file-exists-p (substitute-in-file-name string)))
X      (if (zerop (length string))
X	  (setq name string realdir dir)
X	(setq string (substitute-in-file-name string)
X	      name (file-name-nondirectory string)
X	      realdir (file-name-directory string))
X	(setq realdir (if realdir (expand-file-name realdir dir) dir)))
X      (if action
X	  (ange-ftp-file-name-all-completions name realdir)
X	(let ((specdir (file-name-directory string))
X	      (val (ange-ftp-file-name-completion name realdir)))
X	  (if (and specdir (stringp val))
X	      (ange-ftp-quote-filename (concat specdir val))
X	    val))))))
X
X
X;;;; ------------------------------------------------------------
X;;;; Bits and bobs to bolt ange-ftp into GNU Emacs.
X;;;; ------------------------------------------------------------
X
X(defun ange-ftp-overwrite-fn (fun)
X  "Replace FUN's function definition with ange-ftp-FUN's, saving the
Xoriginal definition as ange-ftp-real-FUN."
X  (let* ((name (symbol-name fun))
X	 (saved (intern (concat "ange-ftp-real-" name)))
X	 (new (intern (concat "ange-ftp-" name))))
X    (or (fboundp saved)
X	(fset saved (symbol-function fun)))
X    (fset fun new)))
X
X(ange-ftp-overwrite-fn 'insert-file-contents)
X(if (not (fboundp 'dired-ls))		; dired has been loaded by now
X    (ange-ftp-overwrite-fn 'dired-readin) ; 18.55 dired
X  ;; tree dired
X  (load "ange-ftp-dired")
X  (ange-ftp-overwrite-fn 'dired-run-shell-command)
X  (ange-ftp-overwrite-fn 'dired-ls))
X(ange-ftp-overwrite-fn 'directory-files)
X(ange-ftp-overwrite-fn 'file-directory-p)
X(ange-ftp-overwrite-fn 'file-writable-p)
X(ange-ftp-overwrite-fn 'file-readable-p)
X(ange-ftp-overwrite-fn 'delete-file)
X(ange-ftp-overwrite-fn 'read-file-name-internal)
X(ange-ftp-overwrite-fn 'verify-visited-file-modtime)
X(ange-ftp-overwrite-fn 'file-exists-p)
X(ange-ftp-overwrite-fn 'write-region)
X(ange-ftp-overwrite-fn 'backup-buffer)
X(ange-ftp-overwrite-fn 'copy-file)
X(ange-ftp-overwrite-fn 'file-attributes)
X(ange-ftp-overwrite-fn 'file-name-directory)
X(ange-ftp-overwrite-fn 'file-name-nondirectory)
X(ange-ftp-overwrite-fn 'file-name-as-directory)
X(ange-ftp-overwrite-fn 'directory-file-name)
X(ange-ftp-overwrite-fn 'expand-file-name)
X
X
X(or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
X    (setq find-file-hooks
X	  (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
X
X
X;;;; ------------------------------------------------------------
X;;;; Finally provide package.
X;;;; ------------------------------------------------------------
X
X(provide 'ange-ftp)
END_OF_FILE
if test 64065 -ne `wc -c <'ange-ftp.el'`; then
    echo shar: \"'ange-ftp.el'\" unpacked with wrong size!
fi
# end of 'ange-ftp.el'
fi
if test -f 'ange-ftp-dired.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ange-ftp-dired.el'\"
else
echo shar: Extracting \"'ange-ftp-dired.el'\" \(2895 characters\)
sed "s/^X//" >'ange-ftp-dired.el' <<'END_OF_FILE'
X;;;; ange-ftp-dired.el - ange-ftp support for tree dired
X;;;; $Id: ange-ftp-dired.el,v 1.3 90/11/23 12:39:46 sk Exp $
X
X;; provide for remote ls:
X
X(defun ange-ftp-dired-ls (file &optional switches wildcard full-directory-p)
X  "Insert ls output of FILE, optionally formatted with SWITCHES.
XOptional third arg WILDCARD means treat FILE as shell wildcard.
XOptional fourth arg FULL-DIRECTORY-P means file is a directory and
Xswitches do not contain \"d\".
X
XSWITCHES default to dired-listing-switches.
XUses dired-ls-program and maybe shell-file-name to do the work.
X
XThis is an emulation of dired-ls with support for remote files using ftp."
X  (setq switches (or switches dired-listing-switches))
X  (let ((parsed (ange-ftp-ftp-path file)))
X    (if parsed
X	(insert
X	 (if wildcard
X	     ;; Prevent ls from inserting subdirs, as the
X	     ;; subdir header line format would be wrong
X	     ;; (it would have no "/user@host:" prefix)
X	     (ange-ftp-ls file (concat switches "d"))
X	   ;; quoting the path part of the file name seems to be a
X	   ;; good idea (using dired.el's shell-quote function), but
X	   ;; ftpd always globs ls args before passing them to
X	   ;; /bin/ls or even doing the ls formatting itself.
X	   ;; --> So wildcard characters in FILE lose.  Sigh...
X	   (ange-ftp-ls file switches)))
X      (ange-ftp-real-dired-ls file switches wildcard))))
X
X(defvar ange-ftp-remote-shell-file-name
X  (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
X      "remsh"
X    "rsh")
X  "Remote shell used by ange-ftp.")
X
X(defun ange-ftp-dired-run-shell-command (command &optional in-background)
X  "Run shell COMMAND, optionally IN-BACKGROUND.
XIf COMMAND is longer than shell-maximum-command-length, you are asked
Xfor confirmation.
X
XThis command has support for remote files using a remote shell as
Xspecified in ange-ftp-remote-shell-file-name."
X  (let* ((parsed (ange-ftp-ftp-path default-directory))
X	 (host (nth 0 parsed))
X	 (user (nth 1 parsed))
X	 (path (nth 2 parsed)))
X    (if (not parsed)
X	(ange-ftp-real-dired-run-shell-command command in-background)
X      (if (> (length path) 0)		; else it's $HOME
X	  (setq command (concat "cd " path "; " command)))
X      (setq command
X	    (format  "%s %s \"%s\""	; remsh -l USER does not work well
X					; on a hp-ux machine I tried
X		     ange-ftp-remote-shell-file-name host command))
X      (message "Remote command '%s' ..." command)
X      ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
X      ;; would prepend "cd default-directory" --- which bombs because
X      ;; default-directory is in ange-ftp syntax for remote path names.
X      (if (or (and shell-maximum-command-length
X		   (< (length command) shell-maximum-command-length))
X	      (yes-or-no-p
X	       (format
X		"Dired shell command is %d bytes long - execute anyway? "
X		(length command))))
X	  (if in-background
X	      (background command)
X	    (shell-command command))))))
X
END_OF_FILE
if test 2895 -ne `wc -c <'ange-ftp-dired.el'`; then
    echo shar: \"'ange-ftp-dired.el'\" unpacked with wrong size!
fi
# end of 'ange-ftp-dired.el'
fi
echo shar: End of shell archive.
exit 0
