;;; Gateways:
;;;
-;;; Sometimes it is neccessary for the FTP process to be run on a different
+;;; Sometimes it is necessary for the FTP process to be run on a different
;;; machine than the machine running GNU Emacs. This can happen when the
;;; local machine has restrictions on what hosts it can access.
;;;
;;;
;;; 3) Using NFS and symlinks, make sure that there is a shared directory with
;;; the *same* name between the local machine and the gateway machine.
-;;; This directory is neccessary for temporary files created by ange-ftp.
+;;; This directory is necessary for temporary files created by ange-ftp.
;;;
;;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
;;; this directory plus an identifying filename prefix. For example:
;;; there is a chance you might connect to an ULTRIX machine (such as
;;; prep.ai.mit.edu), then set this variable accordingly. This will have
;;; the side effect that dired will have problems with symlinks whose names
-;;; end in an @. If you get youself into this situation then editing
+;;; end in an @. If you get yourself into this situation then editing
;;; dired's ls-switches to remove "F", will temporarily fix things.
;;;
;;; 2. If you know that you are connecting to a certain non-UNIX machine
;;; 1. Umask problems:
;;; Be warned that files created by using ange-ftp will take account of the
;;; umask of the ftp daemon process rather than the umask of the creating
-;;; user. This is particulary important when logging in as the root user.
+;;; user. This is particularly important when logging in as the root user.
;;; The way that I tighten up the ftp daemon's umask under HP-UX is to make
;;; sure that the umask is changed to 027 before I spawn /etc/inetd. I
;;; suspect that there is something similar on other systems.
;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
(defvar ange-ftp-multi-msgs
- "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^530-\\|^4[25]1-"
+ "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
"*Regular expression matching messages from the ftp process that start
a multiline reply.")
(defvar ange-ftp-binary-file-name-regexp
(concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
"\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
- "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$")
+ "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|"
+ "\\.taz$\\|\\.tgz$")
"*If a file matches this regexp then it is transferred in binary mode.")
(defvar ange-ftp-gateway-host nil
are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable
above.")
-(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *"
+(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
"*Regexp used to detect that the logging-in sequence is completed on the
gateway machine and that the shell is now awaiting input. Make this regexp as
strict as possible; it shouldn't match *anything* at all except the user's
;;;; Internal variables.
;;;; ------------------------------------------------------------
-(defconst ange-ftp-version "$Revision: 1.21 $")
+(defconst ange-ftp-version "$Revision: 1.44 $")
(defvar ange-ftp-data-buffer-name " *ftp data*"
"Buffer name to hold directory listing data received from ftp process.")
"Return the password for specified HOST and USER, asking user if necessary."
(ange-ftp-parse-netrc)
- ;; look up password in the hash table first; user might have overriden the
+ ;; look up password in the hash table first; user might have overridden the
;; defaults.
(cond ((ange-ftp-lookup-passwd host user))
;;;; ------------------------------------------------------------
(defun ange-ftp-process-handle-line (line proc)
- "Look at the given LINE from the ftp process PROC. Try to catagorize it
+ "Look at the given LINE from the ftp process PROC. Try to categorize it
into one of four categories: good, skip, fatal, or unknown."
(cond ((string-match ange-ftp-xfer-size-msgs line)
(setq ange-ftp-xfer-size
(setq ange-ftp-process-busy nil
ange-ftp-process-result-line line))))
-(defun ange-ftp-process-log-string (proc str)
- "For a given PROCESS, log the given STRING at the end of its
-associated buffer."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (let (moving)
- (set-buffer (process-buffer proc))
- (setq moving (= (point) (process-mark proc)))
- (save-excursion
- ;; Insert the text, moving the process-marker.
- (goto-char (process-mark proc))
- (insert str)
- (set-marker (process-mark proc) (point)))
- (if moving (goto-char (process-mark proc))))
- (set-buffer old-buffer))))
-
(defun ange-ftp-set-xfer-size (host user bytes)
"Set the size of the next FTP transfer in bytes."
(let ((proc (ange-ftp-get-process host user)))
ange-ftp-process-busy
(string-match "^#+$" str)
(setq str (ange-ftp-process-handle-hash str)))
- (ange-ftp-process-log-string proc str)
+ (comint-output-filter proc str)
(if ange-ftp-process-busy
(progn
(setq ange-ftp-process-string (concat ange-ftp-process-string
(defun ange-ftp-gwp-filter (proc str)
(ange-ftp-save-match-data
- (ange-ftp-process-log-string proc str)
+ (comint-output-filter proc str)
(cond ((string-match "login: *$" str)
(send-string proc
(concat
"Attempt to resolve the given HOSTNAME using nslookup if possible."
(interactive "sHost: ")
(if ange-ftp-nslookup-program
- (let ((proc (start-process " *nslookup*" " *nslookup*"
+ (let ((default-directory
+ (if (file-accessible-directory-p default-directory)
+ default-directory
+ exec-directory))
+ (proc (start-process " *nslookup*" " *nslookup*"
ange-ftp-nslookup-program host))
(res host))
(process-kill-without-query proc)
ange-ftp-gateway-ftp-program-name
ange-ftp-ftp-program-name))
(args (append (list ftp-prog) ange-ftp-ftp-program-args))
+ (default-directory
+ (if (file-accessible-directory-p default-directory)
+ default-directory
+ exec-directory))
proc)
(if use-gateway
(if ange-ftp-gateway-program-interactive
(process-kill-without-query proc)
(save-excursion
(set-buffer (process-buffer proc))
- (ange-ftp-mode))
+ (internal-ange-ftp-mode))
(set-process-sentinel proc (function ange-ftp-process-sentinel))
(set-process-filter proc (function ange-ftp-process-filter))
(accept-process-output proc) ;wait for ftp startup message
proc))
-(defun ange-ftp-mode ()
+(defun internal-ange-ftp-mode ()
(interactive)
(comint-mode)
- (setq major-mode 'ange-ftp-mode)
- (setq mode-name "Ange-ftp")
+ (setq major-mode 'internal-ange-ftp-mode)
+ (setq mode-name "Internal Ange-ftp")
(let ((proc (get-buffer-process (current-buffer))))
(goto-char (point-max))
(set-marker (process-mark proc) (point))
(concat "USER request failed: "
(cdr result)))))))
+;; ange@hplb.hpl.hp.com says this should not be changed.
(defvar ange-ftp-hash-mark-msgs
"[hH]ash mark [^0-9]*\\([0-9]+\\)"
"*Regexp matching the FTP client's output upon doing a HASH command.")
;; capability.
(let ((cmd0 (car cmd))
(cmd1 (nth 1 cmd))
+ (ange-ftp-this-user user)
+ (ange-ftp-this-host host)
+ (ange-ftp-this-msg msg)
cmd2 cmd3 host-type fix-name-func)
(cond
cmd1 (format "\"%s %s\"" cmd3 cmd1))))
;; First argument is the remote name
- ((let ((ange-ftp-this-user user)
- (ange-ftp-this-host host)
- (ange-ftp-this-msg msg))
+ ((progn
(setq fix-name-func (or (cdr (assq host-type
ange-ftp-fix-name-func-alist))
'identity))
(cond
((looking-at "^total [0-9]+$")
(forward-line 1)
+ ;; Some systems put in a blank line here.
+ (if (eolp) (forward-line 1))
(ange-ftp-ls-parser))
((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
;; It's an ls error message.
(ange-ftp-set-ascii-mode host user)))
(if (eq visit t)
(progn
+ (set-visited-file-modtime '(0 0))
(ange-ftp-set-buffer-mode)
(setq buffer-file-name filename)
(set-buffer-modified-p nil)))
(ange-ftp-add-file-entry filename))
(ange-ftp-real-write-region start end filename append visit))))
-(defun ange-ftp-insert-file-contents (filename &optional visit)
+(defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
(barf-if-buffer-read-only)
(setq filename (expand-file-name filename))
(let ((parsed (ange-ftp-ftp-name filename)))
(ange-ftp-real-file-readable-p temp))
(setq
size
- (nth 1 (ange-ftp-real-insert-file-contents temp
- visit)))
+ (nth 1 (ange-ftp-real-insert-file-contents
+ temp visit beg end replace)))
(signal 'ftp-error
(list
"Opening input file:"
(ange-ftp-set-ascii-mode host user))
(ange-ftp-del-tmp-name temp))
(if visit
- (setq buffer-file-name filename))
+ (progn
+ (set-visited-file-modtime '(0 0))
+ (setq buffer-file-name filename)))
(list filename size))
(signal 'file-error
(list
"Opening input file"
filename))))
- (ange-ftp-real-insert-file-contents filename visit))))
+ (ange-ftp-real-insert-file-contents filename visit beg end replace))))
(defun ange-ftp-expand-symlink (file dir)
(if (file-name-absolute-p file)
(file-exists-p file)
(ange-ftp-real-file-readable-p file)))
+(defun ange-ftp-file-executable-p (file)
+ (setq file (expand-file-name file))
+ (if (ange-ftp-ftp-name file)
+ (file-exists-p file)
+ (ange-ftp-real-file-executable-p file)))
+
(defun ange-ftp-delete-file (file)
(interactive "fDelete file: ")
(setq file (expand-file-name file))
;; (kill-buffer (current-buffer))))))
;; this is the extended version of ange-ftp-copy-file-internal that works
-;; asyncronously if asked nicely.
+;; asynchronously if asked nicely.
(defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
keep-date &optional msg cont nowait)
(setq filename (expand-file-name filename)
(ange-ftp-del-hash-entry dir ange-ftp-files-hashtable)
(ange-ftp-get-files dir t))))
\f
-(defun ange-ftp-make-directory (dir)
+(defun ange-ftp-make-directory (dir &optional parents)
(interactive (list (expand-file-name (read-file-name "Make directory: "))))
+ (if parents
+ (let ((parent (file-name-directory (directory-file-name dir))))
+ (or (file-exists-p parent)
+ (ange-ftp-make-directory parent parents))))
(if (file-exists-p dir)
(error "Cannot make directory %s: file already exists" dir)
(let ((parsed (ange-ftp-ftp-name dir)))
(ange-ftp-copy-file-internal fn1 tmp1 t nil
(format "Getting %s" fn1))
tmp1))))
-\f
+
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
+ (if (ange-ftp-ftp-name file)
+ (let ((tryfiles (if nosuffix
+ (list file)
+ (list (concat file ".elc") (concat file ".el") file)))
+ copy)
+ (while (and tryfiles (not copy))
+ (condition-case error
+ (setq copy (ange-ftp-file-local-copy (car tryfiles)))
+ (ftp-error nil)))
+ (if copy
+ (unwind-protect
+ (funcall 'load copy noerror nomessage nosuffix)
+ (delete-file copy))
+ (or noerror
+ (signal 'file-error (list "Cannot open load file" file)))))
+ (ange-ftp-real-load file noerror nomessage nosuffix)))
+
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(defun ange-ftp-unhandled-file-name-directory (filename)
(file-name-directory ange-ftp-tmp-name-template))
(let (file-name-handler-alist)
(apply operation args)))))
+
+;;; This regexp takes care of real ange-ftp file names (with a slash
+;;; and colon).
+;;;###autoload
+(or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^/[^/:]*[^/:]:" . ange-ftp-hook-function)
+ file-name-handler-alist)))
+
+;;; This regexp recognizes and absolute filenames with only one component,
+;;; for the sake of hostname completion.
;;;###autoload
-(or (assoc "^/[^/:]+:" file-name-handler-alist)
+(or (assoc "^/[^/:]*\\'" file-name-handler-alist)
(setq file-name-handler-alist
- (cons '("^/[^/:]+:" . ange-ftp-hook-function)
+ (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
file-name-handler-alist)))
;;; The above two forms are sufficient to cause this file to be loaded
(put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
(put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
(put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
+(put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
(put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
(put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
(put 'read-file-name-internal 'ange-ftp 'ange-ftp-read-file-name-internal)
(put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
(put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
(put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
+(put 'load 'ange-ftp 'ange-ftp-load)
;; Turn off truename processing to save time.
;; Treat each name as its own truename.
(defun ange-ftp-real-file-readable-p (&rest args)
(let (file-name-handler-alist)
(apply 'file-readable-p args)))
+(defun ange-ftp-real-file-executable-p (&rest args)
+ (let (file-name-handler-alist)
+ (apply 'file-executable-p args)))
(defun ange-ftp-real-file-symlink-p (&rest args)
(let (file-name-handler-alist)
(apply 'file-symlink-p args)))
(defun ange-ftp-real-shell-command (&rest args)
(let (file-name-handler-alist)
(apply 'shell-command args)))
+(defun ange-ftp-real-load (&rest args)
+ (let (file-name-handler-alist)
+ (apply 'load args)))
\f
;; Here we support using dired on remote hosts.
;; I have turned off the support for using dired on foreign directory formats.
(ange-ftp-real-insert-directory file switches wildcard full))))
(defun ange-ftp-dired-uncache (dir)
- (if (ange-ftp-ftp-name (expand-file-name dir)))
- (setq ange-ftp-ls-cache-file nil))
+ (if (ange-ftp-ftp-name (expand-file-name dir))
+ (setq ange-ftp-ls-cache-file nil)))
(defvar ange-ftp-sans-version-alist nil
"Alist of mapping host type into function to remove file version numbers.")
;; 0 ;success-count
;; (length fn-list) ;total
;; )
-;; ;; normal case... use the interative routine... much cheaper.
+;; ;; normal case... use the interactive routine... much cheaper.
;; (ange-ftp-real-dired-create-files file-creator operation fn-list
;; name-constructor marker-char)))
(defconst ange-ftp-vms-filename-regexp
(concat
- "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][_A-Za-z0-9$---]*\\)\\."
- "[_A-Za-z0-9$---]*;+[0-9]*\\)")
+ "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\."
+ "[-_A-Za-z0-9$]*;+[0-9]*\\)")
"Regular expression to match for a valid VMS file name in Dired buffer.
Stupid freaking bug! Position of _ and $ shouldn't matter but they do.
Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX
;;;; ------------------------------------------------------------
;; Since CMS doesn't have any full file name syntax, we have to fudge
-;; things with cd's. We actually send too many cd's, but is dangerous
+;; things with cd's. We actually send too many cd's, but it's dangerous
;; to try to remember the current minidisk, because if the connection
;; is closed and needs to be reopened, we will find ourselves back in
;; the default minidisk. This is fairly likely since CMS ftp servers
HCoop / bpt / emacs.git / blobdiff