ange@hplb.hpl.hp.com (Andy Norman) (02/01/90)
This package attempts to make accessing files / directories using ftp from
within GNU Emacs as simple as possible. A subset of the normal file-handling
routines are extended to understand about ftp.
To read or write a file using ftp, or to read a directory using ftp, the only
thing that a user needs to do is to specify the filename using a slighly
extended syntax.
Full file name completion is supported on remote files.
Enjoy...
-- ange --
ange@hplb.hpl.hp.com
ange@hpl.hp.co.uk
P.S. This package is not a replacement for ftp.el that comes in the standard
GNU Emacs distribution.
#---------------------------------- cut here ----------------------------------
# This is a shell archive. Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Andy Norman <ange@anorman> on Wed Jan 31 14:44:20 1990
#
# This archive contains:
# ange-ftp.el
#
# Error checking via wc(1) will be performed.
LANG=""; export LANG
PATH=/bin:/usr/bin:$PATH; export PATH
echo x - ange-ftp.el
cat >ange-ftp.el <<'@EOF'
; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File: ange-ftp.el
; RCS: $Header: ange-ftp.el,v 2.11 90/01/31 11:42:09 ange Exp $
; Description: simple ftp access to files from GNU Emacs
; Author: Andy Norman, ange@hplb.hpl.hp.com
; Created: Thu Oct 12 14:00:05 1989
; Modified: Wed Jan 31 11:41:31 1990 (Ange) ange@anorman
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This file is not part of GNU Emacs, but FSF are welcome to it if they want
;;; it.
;;;
;;; Copying is permitted under those conditions described by the GNU General
;;; Public License.
;;;
;;; Copyright (C) 1990 Andy Norman.
;;;
;;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;;;
;;; This package attempts to make accessing files / directories using ftp from
;;; within GNU Emacs as simple as possible. A subset of the normal file-handling
;;; routines are extended to understand about ftp.
;;;
;;; To read or write a file using ftp, or to read a directory using ftp, the
;;; only thing that a user needs to do is to specify the filename using a
;;; slighly extended syntax.
;;;
;;; The default syntax of ftp files is /user@host:path. This is customizable.
;;; See the variables: ange-ftp-path-exp, ange-ftp-path-user-exp,
;;; ange-ftp-path-host-exp and ange-ftp-path-path-exp for more details.
;;;
;;; A password is required for each host/user pair. This will be prompted for
;;; when needed, unless already set by calling ange-ftp-set-passwd, or
;;; specified in a valid ~/.netrc file.
;;;
;;; Ftp processes are left running for speed. They can easily be killed by
;;; killing their associated buffer.
;;;
;;; Full file name completion is supported on remote files.
;;;
;;; WARNING, the following GNU Emacs functions are replaced by this program:
;;;
;;; insert-file-contents
;;; dired-readin
;;; file-directory-p
;;; file-writable-p
;;; delete-file
;;; read-file-name-internal
;;; verify-visited-file-modtime
;;;
;;; If you find any bugs or problems with this package, please e-mail the above
;;; author. Constructive comments are especially welcome.
;;;
;;;; ------------------------------------------------------------
;;;; User customizable variables.
;;;; ------------------------------------------------------------
(defconst ange-ftp-good-msgs
"^220 \\|^230 \\|^226 \\|^251 \\|^221 \\|^200 NOOP \\|^200 DELE "
"*Regular expression matching messages from the ftp process that indicate that
the action that was initiated has completed successfully.")
(defconst ange-ftp-skip-msgs
"^200 PORT \\|^331 \\|^150 \\|^[0-9]+ bytes \\|^Connected \\|^$"
"*Regular expression matching messages from the ftp process that can be
ignored.")
(defconst ange-ftp-fatal-msgs
"^ftp: \\|^Not connected\\|^530 "
"*Regular expression matching messages from the ftp process that indicate
something has gone drastically wrong attempting the action that was initiated.")
(defconst ange-ftp-path-exp
"/[^/]*@[^:]*:"
"*Regular expression which uniquely identifies a fully expanded pathname as
being a remote pathname.")
(defconst ange-ftp-path-user-exp
"/\\([^@]*\\)"
"*Regular expression that matches the user part of a remote pathname.")
(defconst ange-ftp-path-host-exp
"@\\([^:]*\\)"
"*Regular expression that matches the host part of a remote pathname.")
(defconst ange-ftp-path-path-exp
":\\(.*\\)"
"*Regular expression that matches the path part of a remote pathname.")
(defconst ange-ftp-ls-follow-symbolic-links t
"*If t, tell ls to always follow symbolic links.")
(defconst ange-ftp-tmp-name-template "/tmp/ange-ftp"
"*Template given to make-temp-name to create temporary files.")
(defconst ange-ftp-netrc-filename "~/.netrc"
"*File in .netrc format to search for passwords.")
;;;; ------------------------------------------------------------
;;;; Internal variables.
;;;; ------------------------------------------------------------
(defconst ange-ftp-data-buffer-name "*ftp data*"
"Buffer name to hold data received from ftp process.")
(defvar ange-ftp-passwd-alist nil
"Association list of ((HOST USER) PASSWORD) pairs.")
(defvar ange-ftp-process-string ""
"Currently unprocessed output from the ftp process.")
(defvar ange-ftp-process-running nil
"Boolean indicates whether the ftp process is currently handling
an action.")
(defvar ange-ftp-process-status nil
"Set to t if a action sent to the ftp process succeeds.")
(defvar ange-ftp-fdp-cache-file nil
"Last filename passed to ange-ftp-file-directory-p.")
(defvar ange-ftp-fdp-cache-value nil
"Last result from ange-ftp-file-directory-p.")
(defvar ange-ftp-gdf-cache-directory nil
"Last directory name passed to ange-ftp-get-directory-files.")
(defvar ange-ftp-gdf-cache-value nil
"Last result from ange-ftp-get-directory-files.")
(defvar ange-ftp-have-read-netrc nil
"Boolean indicating whether the user's .netrc file has been read yet.")
;;;; ------------------------------------------------------------
;;;; Password support.
;;;; ------------------------------------------------------------
(defun ange-ftp-read-passwd (prompt)
"Read a password from the user. Echos a . for each character typed.
End with <cr>, <lf>, or <esc>. DEL or backspace rubs out."
(let ((pass "")
(c 0)
(echo-keystrokes 0))
(while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
(message "%s%s"
prompt
(make-string (length pass) ?.))
(setq c (read-char))
(if (and (/= c ?\b) (/= c ?\177))
(setq pass (concat pass (char-to-string c)))
(if (> (length pass) 0)
(setq pass (substring pass 0 -1)))))
(substring pass 0 -1)))
(defun ange-ftp-set-passwd (host user passwd)
"For a given HOST and USER, set or change the associated PASSWD."
(interactive (list (read-string "host: ")
(read-string "user: ")
(ange-ftp-read-passwd "passwd: ")))
(let ((entry (assoc (list host user) ange-ftp-passwd-alist)))
(if (null entry)
(setq ange-ftp-passwd-alist
(cons (list (list host user) passwd)
ange-ftp-passwd-alist))
(rplacd entry (list passwd)))))
(defun ange-ftp-get-passwd (host user)
"Given a HOST and USER, return the ftp password, prompting if not previously
set."
(or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
(let ((entry (assoc (list host user) ange-ftp-passwd-alist)))
(or (nth 1 entry)
(let ((passwd (ange-ftp-read-passwd (format "passwd for %s@%s: " user host))))
(ange-ftp-set-passwd host user passwd)
passwd))))
;;;; ------------------------------------------------------------
;;;; ~/.netrc support
;;;; ------------------------------------------------------------
(defun ange-ftp-parse-field (name limit)
"Move along current line looking for the value of the field NAME. Valid
separators between NAME and its value are commas and spaces. The second arg
LIMIT is a limit for the search."
(if (re-search-forward name limit 'end)
(let (beg)
(skip-chars-forward ", \t" limit)
(setq beg (point))
(skip-chars-forward "^, \t" limit)
(buffer-substring beg (point)))))
(defun ange-ftp-parse-line ()
"Extract the values of the fields MACHINE, LOGIN and PASSWORD from the current
line of the buffer. If successful calls ange-ftp-set-passwd with the values
found. Returns success."
(let ((eol (progn (end-of-line) (point)))
machine login password)
(beginning-of-line)
(setq machine (ange-ftp-parse-field "machine" eol))
(setq login (ange-ftp-parse-field "login" eol))
(setq password (ange-ftp-parse-field "password" eol))
(and machine login
(ange-ftp-set-passwd machine login password))
machine))
(defun ange-ftp-parse-netrc ()
"If a users ~/.netrc file exists and has the correct security then extract the
MACHINE, LOGIN and PASSWORD information from each line."
(let* ((file (expand-file-name ange-ftp-netrc-filename))
(attr (file-attributes file)))
(if (and attr ;file exists
(eq (nth 2 attr) (user-uid)) ;same uids
(string-match ".r..------" (nth 8 attr))) ;readable by user only
(save-excursion
(set-buffer (find-file-noselect file))
(goto-char (point-min))
(while (ange-ftp-parse-line)
(next-line 1))
(kill-buffer (current-buffer))))))
;;;; ------------------------------------------------------------
;;;; FTP process filter support.
;;;; ------------------------------------------------------------
(defun ange-ftp-process-handle-line (line)
"Look at the given LINE from the ftp process. Try to catagorize it
into one of four categories: good, skip, fatal, or unknown."
(cond ((string-match ange-ftp-good-msgs line)
(setq ange-ftp-process-running nil)
(setq ange-ftp-process-status t))
((string-match ange-ftp-skip-msgs line)
t)
((string-match ange-ftp-fatal-msgs line)
(delete-process proc)
(setq ange-ftp-process-running nil))
(t
(setq ange-ftp-process-running nil))))
(defun ange-ftp-process-log-string (proc str)
"For a given PROCESS, log the given STRING at the end of its
associated buffer."
(save-excursion
(set-buffer (process-buffer proc))
(goto-char (point-max))
(insert str)))
(defun ange-ftp-process-filter (proc str)
"Build up a complete line of output from the ftp PROCESS and pass it
on to ange-ftp-process-handle-line to deal with."
(setq ange-ftp-process-string (concat ange-ftp-process-string str))
(ange-ftp-process-log-string proc str)
(while (and ange-ftp-process-running
(string-match "\n" ange-ftp-process-string))
(let ((line (substring ange-ftp-process-string 0 (match-beginning 0))))
(setq ange-ftp-process-string (substring ange-ftp-process-string
(match-end 0)))
(if (string-match "^ftp> " line)
(setq line (substring line (match-end 0))))
(ange-ftp-process-handle-line line))))
(defun ange-ftp-process-sentinel (proc str)
"Ftp process sentinal called when the ftp process changes state.
Flushes all caches."
(ange-ftp-flush-all-caches))
;;;; ------------------------------------------------------------
;;;; Miscellaneous tools...
;;;; ------------------------------------------------------------
(defun ange-ftp-ftp-process-buffer (host user)
"Return the name of the buffer that collects output from the ftp process
connected to the given HOST and USER pair."
(concat "*ftp " user "@" host "*"))
(defun ange-ftp-error (host user msg)
"Display the last chunk of output from the ftp process for the given HOST
USER pair, and signal an error including MSG in the text."
(let ((cur (selected-window))
(pop-up-windows t))
(pop-to-buffer
(get-buffer-create
(ange-ftp-ftp-process-buffer host user)))
(goto-char (point-max))
(select-window cur))
(error "ange-ftp: %s" msg))
(defun ange-ftp-flush-all-caches ()
"Clean out all file and directory caches used by ange-ftp."
(setq ange-ftp-fdp-cache-file nil)
(setq ange-ftp-gdf-cache-directory nil))
;;;; ------------------------------------------------------------
;;;; Support for sending commands to the ftp process.
;;;; ------------------------------------------------------------
(defun ange-ftp-raw-send-cmd (proc cmd)
"Low-level routine to send the given ftp CMD to the ftp PROCESS.
Returns non-NIL if succeeded."
(if (equal (process-status proc) 'run)
(save-excursion
(setq ange-ftp-process-string "")
(setq ange-ftp-process-running t)
(setq ange-ftp-process-status nil)
(send-string proc (concat cmd "\n"))
(while ange-ftp-process-running
(accept-process-output proc))
ange-ftp-process-status)
nil))
(defun ange-ftp-get-process (host user)
"Return the process object for a ftp process connected to HOST and
logged in as USER. Create a new proces if needed."
(let* ((name (ange-ftp-ftp-process-buffer host user))
(proc (get-process name)))
(if (and proc (equal (process-status proc) 'run))
proc
(let ((pass (ange-ftp-get-passwd host user)))
(setq proc (start-process name name "ftp" "-i" "-n" "-g" "-v"))
(process-kill-without-query proc)
(set-process-sentinel proc 'ange-ftp-process-sentinel)
(set-process-filter proc 'ange-ftp-process-filter)
(message "opening ftp connection to %s..." host)
(or (ange-ftp-raw-send-cmd proc (format "open %s" host))
(ange-ftp-error host user "OPEN request failed"))
(message "logging in as user %s..." user)
(or (ange-ftp-raw-send-cmd proc (format "user %s %s" user pass))
(progn
(ange-ftp-set-passwd host user nil) ;reset password
(ange-ftp-error host user "USER request failed")))
(message "logging in as user %s...done" user)
proc))))
(defun ange-ftp-send-cmd (host user cmd)
"Find an ftp process connected to HOST logged in as USER and send it CMD.
Returns whether successful."
(let ((proc (ange-ftp-get-process host user)))
(or (ange-ftp-raw-send-cmd proc cmd) ;failed, try ONCE more
(and (setq proc (ange-ftp-get-process host user))
(ange-ftp-raw-send-cmd proc cmd)))))
;;;; ------------------------------------------------------------
;;;; Remote pathname syntax support.
;;;; ------------------------------------------------------------
(defun ange-ftp-get-path-user (path)
"Return the user part from the remote PATH. If the user part is blank then
take the current user's login name as a default."
(string-match ange-ftp-path-user-exp path)
(let ((user (substring path
(match-beginning 1)
(match-end 1))))
(if (zerop (length user))
(user-login-name)
user)))
(defun ange-ftp-get-path-host (path)
"Return the host part from the remote PATH."
(string-match ange-ftp-path-host-exp path)
(substring path (match-beginning 1) (match-end 1)))
(defun ange-ftp-get-path-path (path)
"Return the path part from the remote PATH."
(string-match ange-ftp-path-path-exp path)
(substring path (match-beginning 1) (match-end 1)))
(defun ange-ftp-ftp-path-p (path)
"Return whether PATH is considered remote."
(string-match ange-ftp-path-exp path))
;;;; ------------------------------------------------------------
;;;; Simple remote file I/O support.
;;;; ------------------------------------------------------------
(defun ange-ftp-save-ftp-file ()
"Used as a 'write-file-hook' entry, this routine attempts to write the current
buffer to its associated remote file using ftp. Returns success."
(and (ange-ftp-ftp-path-p buffer-file-name)
(let ((host (ange-ftp-get-path-host buffer-file-name))
(user (ange-ftp-get-path-user buffer-file-name))
(path (ange-ftp-get-path-path buffer-file-name))
(temp (make-temp-name ange-ftp-tmp-name-template)))
(ange-ftp-set-buffer-mode)
(write-region (point-min) (point-max) temp nil 'foobar)
(unwind-protect
(or (ange-ftp-send-cmd host user
(format "put %s %s" temp path))
(ange-ftp-error host user "put request failed"))
(delete-file temp))
(set-buffer-modified-p nil)
(message "Wrote %s" buffer-file-name)
t)))
(defun ange-ftp-insert-file-contents (filename &optional visit)
"Insert contents of file FILENAME after point.
Returns list of absolute pathname and length of data inserted.
If second argument VISIT is non-nil, the buffer's visited filename
and last save file modtime are set, and it is marked unmodified.
If visiting and the file does not exist, visiting is completed
before the error is signaled.
Note this this function has been extended to deal with remote files
using ftp."
(barf-if-buffer-read-only)
(setq filename (expand-file-name filename))
(if (ange-ftp-ftp-path-p filename)
(let ((host (ange-ftp-get-path-host filename))
(user (ange-ftp-get-path-user filename))
(path (ange-ftp-get-path-path filename))
(temp (make-temp-name ange-ftp-tmp-name-template))
result)
(and visit (setq buffer-file-name filename))
(or (ange-ftp-send-cmd host user
(format "get %s %s" path temp))
(signal 'file-error
(list
"Opening input file"
"Unable to get remote file"
filename)))
(setq result (ange-ftp-real-insert-file-contents temp visit))
(and visit (setq buffer-file-name filename))
(condition-case eek (delete-file temp) (error nil))
result)
(ange-ftp-real-insert-file-contents filename visit)))
(defun ange-ftp-revert-buffer (arg noconfirm)
"Revert this buffer from a remote file using ftp."
(let ((opoint (point)))
(cond ((null buffer-file-name)
(error "Buffer does not seem to be associated with any file"))
((or noconfirm
(yes-or-no-p (format "Revert buffer from file %s? "
buffer-file-name)))
(let ((buffer-read-only nil))
;; Bind buffer-file-name to nil
;; so that we don't try to lock the file.
(let ((buffer-file-name nil))
(unlock-buffer)
(erase-buffer))
(insert-file-contents buffer-file-name t))
(goto-char (min opoint (point-max)))
(after-find-file nil)
t))))
(defun ange-ftp-set-buffer-mode ()
"Set the correct modes for the current buffer if it is visiting a remote
file."
(if (ange-ftp-ftp-path-p buffer-file-name)
(progn
(auto-save-mode 0)
(make-variable-buffer-local 'make-backup-files)
(setq make-backup-files nil)
(make-variable-buffer-local 'revert-buffer-function)
(setq revert-buffer-function 'ange-ftp-revert-buffer))))
;;;; ------------------------------------------------------------
;;;; Remote file and directory listing support.
;;;; ------------------------------------------------------------
(defun ange-ftp-ls (file lsargs &optional want-buffer)
"Return the output of an 'ls' command done on a remote machine using ftp.
The first argument FILE is the full name of the remote file, the second arg
LSARGS is any args to pass to the 'ls' command, and the optional third arg
WANT-BUFFER indicates that a buffer object should be returned rather than
a string object."
(if (ange-ftp-ftp-path-p file)
(let ((host (ange-ftp-get-path-host file))
(user (ange-ftp-get-path-user file))
(path (ange-ftp-get-path-path file))
(temp (make-temp-name ange-ftp-tmp-name-template)))
(if ange-ftp-ls-follow-symbolic-links
(if (> (length lsargs) 0)
(setq lsargs (concat lsargs "L"))
(setq lsargs "-L")))
(if (ange-ftp-send-cmd host user (format "ls \"%s %s\" %s"
lsargs
path
temp))
(let (data)
(save-excursion
(set-buffer (get-buffer-create ange-ftp-data-buffer-name))
(erase-buffer)
(insert-file-contents temp)
(if want-buffer
(setq data (current-buffer))
(setq data (buffer-substring (point-min) (point-max)))
(kill-buffer (current-buffer)))
(condition-case err (delete-file temp) (error nil)))
data)
(ange-ftp-error host user "unable to get a remote ls")))))
(defun ange-ftp-file-directory-p (file)
"Return t if file FILENAME is the name of a directory as a file.
A directory name spec may be given instead; then the value is t
if the directory so specified exists and really is a directory.
Note that this function has been extended to deal with remote files
using ftp."
(setq file (expand-file-name file))
(if (ange-ftp-ftp-path-p file)
(progn
(setq file (file-name-as-directory file))
(if (and ange-ftp-fdp-cache-file
(string-equal ange-ftp-fdp-cache-file
file))
ange-ftp-fdp-cache-value
(progn
(setq ange-ftp-fdp-cache-file file)
(setq ange-ftp-fdp-cache-value
(string-match "^d" (ange-ftp-ls file "-dl"))))))
(ange-ftp-real-file-directory-p file)))
(defun ange-ftp-file-writable-p (file)
"Return t if file FILENAME can be written or created by you.
Note that this function has been extended to deal with remote files
using ftp."
(setq file (expand-file-name file))
(or (ange-ftp-ftp-path-p file)
(ange-ftp-real-file-writable-p file)))
;;;; ------------------------------------------------------------
;;;; Simple Dired support.
;;;; ------------------------------------------------------------
(require 'dired)
(defun ange-ftp-dired-readin (dirname buffer)
"Emulation of dired-readin with support for remote files using ftp."
(save-excursion
(message "Reading directory %s..." dirname)
(set-buffer buffer)
(let ((buffer-read-only nil))
(widen)
(erase-buffer)
(setq dirname (expand-file-name dirname))
(if (ange-ftp-ftp-path-p dirname)
(insert (ange-ftp-ls dirname dired-listing-switches))
(if (file-directory-p dirname)
(call-process "ls" nil buffer nil
dired-listing-switches dirname)
(let ((default-directory (file-name-directory dirname)))
(call-process shell-file-name nil buffer nil
"-c" (concat "ls " dired-listing-switches " "
(file-name-nondirectory dirname))))))
(goto-char (point-min))
(while (not (eobp))
(insert " ")
(forward-line 1))
(goto-char (point-min)))
(message "Reading directory %s...done" dirname)))
(defun ange-ftp-delete-file (file)
"Delete specified file. One argument, a file name string.
If file has multiple names, it continues to exist with the other names.
Note that this function has been extended to deal with remote files using
ftp."
(interactive "fDelete file: ")
(setq file (expand-file-name file))
(if (ange-ftp-ftp-path-p file)
(let ((host (ange-ftp-get-path-host file))
(user (ange-ftp-get-path-user file))
(path (ange-ftp-get-path-path file)))
(ange-ftp-flush-all-caches)
(or (ange-ftp-send-cmd host
user
(concat "delete " path))
(signal 'file-error
(list
"Removing old name"
"Unable to execute remote delete command"
path))))
(ange-ftp-real-delete-file file)))
;;;; ------------------------------------------------------------
;;;; File name completion support.
;;;; ------------------------------------------------------------
(defun ange-ftp-get-filename ()
"Simplistic way of getting the filename from a dired-like listing."
(save-excursion
(let ((bol (progn (beginning-of-line) (point)))
eol)
(end-of-line)
(setq eol (point))
(and (search-backward " " bol t)
(buffer-substring (+ 1 (point)) eol)))))
(defun ange-ftp-get-directory-files (directory)
"Return a list of entries in the remote DIRECTORY. Each entry is
wrapped in a list in order that the overall result can immediately
be passed to either all-completions or try-completions."
(if (and ange-ftp-gdf-cache-directory
(string-equal directory ange-ftp-gdf-cache-directory))
ange-ftp-gdf-cache-value
(save-excursion
(set-buffer (ange-ftp-ls directory "-al" t))
(goto-char (point-min))
(next-line 1) ;skip over total
(let (res file)
(while (setq file (ange-ftp-get-filename))
(beginning-of-line)
(if (looking-at "^d")
(setq file (file-name-as-directory file)))
(setq res (cons (list file) res))
(next-line 1))
(or res (setq res (list res))) ;make empty list
(kill-buffer (current-buffer))
(setq ange-ftp-gdf-cache-directory directory)
(setq ange-ftp-gdf-cache-value res)))))
(defun ange-ftp-gdf-cache-applies (file)
"Return whether the gdf cache applies to this file."
(if ange-ftp-gdf-cache-directory
(or (string-equal ange-ftp-gdf-cache-directory
(file-name-directory file))
(and (zerop (length (file-name-nondirectory file)))
(string-equal ange-ftp-gdf-cache-directory
(file-name-directory
(substring file 0 -1)))))))
(defun ange-ftp-file-exists-p (file)
"Return t if file FILENAME exists."
(setq file (expand-file-name file))
(if (ange-ftp-ftp-path-p file)
(if (ange-ftp-gdf-cache-applies file)
(let ((name (file-name-nondirectory file)))
(or (zerop (length name))
(assoc name ange-ftp-gdf-cache-value)))
(> (length (ange-ftp-ls file "-d")) 0))
(file-exists-p file)))
(defun ange-ftp-file-name-all-completions (file dir)
"Return a list of all completions of file name FILE in directory DIR."
(if (ange-ftp-ftp-path-p dir)
(all-completions file (ange-ftp-get-directory-files dir))
(file-name-all-completions file dir)))
(defun ange-ftp-file-name-completion (file dir)
"Complete file name FILE in directory DIR.
Returns the longest string common to all filenames in DIR
that start with FILE.
If there is only one and FILE matches it exactly, returns t.
Returns nil if DIR contains no name starting with FILE."
(if (ange-ftp-ftp-path-p dir)
(try-completion file (ange-ftp-get-directory-files dir))
(file-name-completion file dir)))
(defun ange-ftp-quote-filename (file)
"Quote $ as $$ to get it past substitute-in-file-name."
(let (res)
(mapcar
(function (lambda (char)
(if (= char ?$)
(setq res (cons char res)))
(setq res (cons char res))))
file)
(concat (nreverse res))))
(defun ange-ftp-read-file-name-internal (string dir action)
"Emulates read-file-name-internal."
(let (name realdir)
(if (eq action 'lambda)
(if (> (length string) 0)
(ange-ftp-file-exists-p (substitute-in-file-name string)))
(if (zerop (length string))
(setq name string realdir dir)
(setq string (substitute-in-file-name string))
(setq name (file-name-nondirectory string))
(setq realdir (file-name-directory string))
(if realdir
(setq realdir (expand-file-name realdir dir))
(setq realdir dir)))
(if action
(ange-ftp-file-name-all-completions name realdir)
(let ((specdir (file-name-directory string))
(val (ange-ftp-file-name-completion name realdir)))
(if (and specdir (stringp val))
(ange-ftp-quote-filename (concat specdir val))
val))))))
(defun ange-ftp-verify-visited-file-modtime (buf)
"Return t if last mod time of BUF's visited file matches what BUF records.
This means that the file has not been changed since it was visited or saved.
Note that this function has been extended to deal with remote files using
ftp."
(let ((name (buffer-file-name buf)))
(if (and (stringp name) (ange-ftp-ftp-path-p name))
t
(ange-ftp-real-verify-visited-file-modtime buf))))
;;;; ------------------------------------------------------------
;;;; Bits and bobs to bolt ange-ftp into GNU Emacs.
;;;; ------------------------------------------------------------
(defun ange-ftp-overwrite-fn (orig saved new)
"Zap ORIG's function definition with NEW's, saving the orignal definition
as the function SAVED."
(or (fboundp saved)
(fset saved (symbol-function orig)))
(fset orig new))
(ange-ftp-overwrite-fn 'insert-file-contents
'ange-ftp-real-insert-file-contents
'ange-ftp-insert-file-contents)
(ange-ftp-overwrite-fn 'dired-readin
'ange-ftp-real-dired-readin
'ange-ftp-dired-readin)
(ange-ftp-overwrite-fn 'file-directory-p
'ange-ftp-real-file-directory-p
'ange-ftp-file-directory-p)
(ange-ftp-overwrite-fn 'file-writable-p
'ange-ftp-real-file-writable-p
'ange-ftp-file-writable-p)
(ange-ftp-overwrite-fn 'delete-file
'ange-ftp-real-delete-file
'ange-ftp-delete-file)
(ange-ftp-overwrite-fn 'read-file-name-internal
'ange-ftp-real-read-file-name-internal
'ange-ftp-read-file-name-internal)
(ange-ftp-overwrite-fn 'verify-visited-file-modtime
'ange-ftp-real-verify-visited-file-modtime
'ange-ftp-verify-visited-file-modtime)
(or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
(setq find-file-hooks
(cons 'ange-ftp-set-buffer-mode find-file-hooks)))
(or (memq 'ange-ftp-save-ftp-file write-file-hooks)
(setq write-file-hooks
(cons 'ange-ftp-save-ftp-file write-file-hooks)))
;;;; ------------------------------------------------------------
;;;; Finally provide package.
;;;; ------------------------------------------------------------
(provide 'ange-ftp)
@EOF
set `wc -lwc <ange-ftp.el`
if test $1$2$3 != 757295027719
then
echo ERROR: wc results of ange-ftp.el are $* should be 757 2950 27719
fi
chmod 644 ange-ftp.el
exit 0
--
-- ange --
ange@hplb.hpl.hp.comjbm@hpfijbm.HP.COM (Jim Moy) (02/06/90)
> P.S. This package is not a replacement for ftp.el that comes in the standard > GNU Emacs distribution. Andy is too modest here. This package *should* eventually become a replacement for the ftp.el that comes with GNU. I have been using it for a few months (Andy released it within HP first) and I have found it to be an essential tool since I do a lot of editing of files on remote machines. Its interface is much nicer than the various remote editing packages I've seen come by, its links to dired in particular. It is especially effective on a local subnet because both the passwords and the ftp processes are kept around making subsequent accesses to files very fast, compared to ftp.el or some other packages which used rcp. The only thing ftp.el does better is put transfers in the background for slow net connections. If ange-ftp had a way to easily specify a background transfer (not trivial since it implements changes to lower level functions, not just elisp commands), I'd have no problem with folding it into GNU and chucking ftp.el. Jim Moy Design Methods & Systems Group | jbm@hpfcla jbm%hpfcla@hplabs.hp.com Colorado Integrated Circuits Division | hplabs!hpfcla!jbm Jim MOY /HPC500/UX Building 2 Upper - Mail Stop 72 | 3404 East Harmony Road | "What the heck is feminine protection, Hewlett Packard, Ft. Collins CO 80525 | anyways, a chartreuse flamethrower?" Telnet: 229-3181 Bell: (303)229-3181 | -Portney
mikec@hilbert.praxis.co.uk (Michael Chace) (02/09/90)
Hi All, Just one slight problem with the package if you develop S/W on Un*x and VMS. EXOS FTP servers don't support ls -l commands. I'm working on this. Perhaps someone has solved this problem already so that the FTP dir command is used instead. Pity, since for talking to Un*x machines, I think the package is very good. Mike **** ............................................................................. | ARPA : mikec@praxis.co.uk | Michael Chace | | JANET : mikec@uk.co.praxis | PraXis Electronic Design | | UUCP : ...!uunet!mcvax!ukc!praxis!mikec | The New Church | | AMPRNET: g6dhu@g6dhu.ampr.org [44.131.20.3] | Henry Street | | AX25 : G6DHU @ G6DHU-2 or G6DHU @ GB7IMB | Bath Avon | | Phone : (44) [0]225 444700 | BA1 1PX UK | .............................................................................
sivagnan@handel.CS.ColoState.Edu (S. Vasanthan) (02/11/90)
In article <15020003@hpfijbm.HP.COM> jbm@hpfijbm.HP.COM (Jim Moy) writes: >> P.S. This package is not a replacement for ftp.el that comes in the standard >> GNU Emacs distribution. > Andy is too modest here. This package *should* eventually become a > replacement for the ftp.el that comes with GNU. I agree, I have been using it for the past 4 months and have had no problems wit it. Its been an efficient tool for remote editing, and listing of remote file, especially ftp-sites. -- Vasanthan Dept. of CS, CSU.
rxet30@toto.oakhill.uucp (Steve Hamm) (02/12/90)
In article <SIVAGNAN.90Feb10200707@handel.CS.ColoState.Edu> (S. Vasanthan) writes: >> P.S. This package is not a replacement for ftp.el that comes in the standard >> GNU Emacs distribution. > Andy is too modest here. This package *should* eventually become a > replacement for the ftp.el that comes with GNU. I agree, I have been using it for the past 4 months and have had no problems wit it. Its been an efficient tool for remote editing, and listing of remote file, especially ftp-sites. The acclaim for the package just convinced me (that and just having used the (somewhat clumsy) existing ftp package). My problem: I missed the posting. Could someone please mail it to me? Thanks --Steve -- Steve Hamm Motorola Inc. Semiconductor Sector CAD, Austin TX (512) 928-6612 oakhill!austoto!rxet30@cs.utexas.edu {uunet,harvard,gatech,pyramid}!cs.utexas.edu!oakhill!austoto!rxet30 (Real Internet connection is in the works! but for now....!!@)
ange@hplb.hpl.hp.com (Andy Norman) (02/12/90)
>>>>> On 9 Feb 90 15:47:28 GMT, mikec@hilbert.praxis.co.uk (Michael Chace) said: mike> Just one slight problem with the package if you develop S/W on Un*x and mike> VMS. EXOS FTP servers don't support ls -l commands. I'm working on this. Don't waste time working on it. Just e-mail me directly. mike> Perhaps someone has solved this problem already so that the FTP dir mike> command is used instead. Below, I include a patch for the posted version of ange-ftp.el that may well solve your problem. The patch augments ange-ftp.el with the following features: * Optionally limit directory listings to use the 'dir' command. See the variable 'ange-ftp-brain-dead-ls-command' for more info. * Optionally use a specified user-name when not explicly given in the pathname. Previously the user's login name was used. See the variable 'ange-ftp-default-user' for more info. * Optionally generate a suitable password when logging in as user 'anonymous'. Previously the password had to be specified manually. See the variable 'ange-ftp-generate-anonymous-password' for more info. mike> Pity, since for talking to Un*x machines, I think the package is very good. Many thanks. The package was developed primarily for talking to Un*x machines, but a subset of the package *may* work with VMS. Hope this helps... if not then please e-mail me and I'll try to help out... -- ange -- #---------------------------------- cut here ---------------------------------- # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by Andy Norman <ange@hplb.hpl.hp.com> on Mon Feb 12 10:00:35 1990 # # This archive contains: # ange-ftp.el-patch1 # # Error checking via wc(1) will be performed. LANG=""; export LANG PATH=/bin:/usr/bin:$PATH; export PATH echo x - ange-ftp.el-patch1 cat >ange-ftp.el-patch1 <<'@EOF' 5c5 < ; RCS: $Header: ange-ftp.el,v 2.11 90/01/31 11:42:09 ange Exp $ --- > ; RCS: $Header: ange-ftp.el,v 2.13 90/02/08 13:40:57 ange Exp $ 9c9 < ; Modified: Wed Jan 31 11:41:31 1990 (Ange) ange@anorman --- > ; Modified: Thu Feb 8 13:40:04 1990 (Ange) ange@anorman 63c63 < "^220 \\|^230 \\|^226 \\|^251 \\|^221 \\|^200 NOOP \\|^200 DELE " --- > "^220 \\|^230 \\|^226 \\|^251 \\|^221 \\|^200 NOOP \\|^200 DELE \\|^200 CWD " 102a103,105 > (defvar ange-ftp-default-user nil > "*User name to use when none is specied in a pathname. > If nil, then the name under which the user is logged in is used.") 103a107,112 > (defvar ange-ftp-generate-anonymous-password nil > "*Use a password of user@host when logging in as the anonymous user.") > > (defvar ange-ftp-brain-dead-ls-command nil > "*This ftp doesn't allow ls or dir commands to take options.") > 178a188,190 > (and ange-ftp-generate-anonymous-password > (string-equal user "anonymous") > (concat (user-login-name) "@" (system-name))) 365c377 < (user-login-name) --- > (or ange-ftp-default-user (user-login-name)) 471a484,490 > (defun ange-ftp-cd (dir) > "Change remote directory to the directory given. Return success." > (let ((host (ange-ftp-get-path-host dir)) > (user (ange-ftp-get-path-user dir)) > (path (ange-ftp-get-path-path dir))) > (ange-ftp-send-cmd host user (concat "cd " path)))) > 482,490c501,510 < (temp (make-temp-name ange-ftp-tmp-name-template))) < (if ange-ftp-ls-follow-symbolic-links < (if (> (length lsargs) 0) < (setq lsargs (concat lsargs "L")) < (setq lsargs "-L"))) < (if (ange-ftp-send-cmd host user (format "ls \"%s %s\" %s" < lsargs < path < temp)) --- > (temp (make-temp-name ange-ftp-tmp-name-template)) > lscmd) > (if ange-ftp-brain-dead-ls-command > (setq lscmd (concat "dir " path " " temp)) > (if ange-ftp-ls-follow-symbolic-links > (if (> (length lsargs) 0) > (setq lsargs (concat lsargs "L")) > (setq lsargs "-L"))) > (setq lscmd (format "ls \"%s %s\" %s" lsargs path temp))) > (if (ange-ftp-send-cmd host user lscmd) 522c542,544 < (string-match "^d" (ange-ftp-ls file "-dl")))))) --- > (if ange-ftp-brain-dead-ls-command > (ange-ftp-cd file) > (string-match "^d" (ange-ftp-ls file "-dl"))))))) @EOF set `wc -lwc <ange-ftp.el-patch1` if test $1$2$3 != 663142350 then echo ERROR: wc results of ange-ftp.el-patch1 are $* should be 66 314 2350 fi chmod 644 ange-ftp.el-patch1 exit 0 -- -- ange -- ange@hplb.hpl.hp.com