;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;;; Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;;; Copyright (C) 1989,90,91,92,93,94 Free Software Foundation, Inc.
;;;
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Keywords: comm
;;; 2. Some combinations of FTP clients and servers break and get out of sync
;;; when asked to list a non-existent directory. Some of the ai.mit.edu
;;; machines cause this problem for some FTP clients. Using
-;;; ange-ftp-kill-process can be used to restart the ftp process, which
+;;; ange-ftp-kill-ftp-process can restart the ftp process, which
;;; should get things back in synch.
;;;
;;; 3. Ange-ftp does not check to make sure that when creating a new file,
(defvar ange-ftp-multi-msgs
"^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
- "*Regular expression matching messages from the ftp process that start
-a multiline reply.")
+ "*Regular expression matching the start of a multiline ftp reply.")
(defvar ange-ftp-good-msgs
"^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
- "*Regular expression matching messages from the ftp process that indicate
-that the action that was initiated has completed successfully.")
+ "*Regular expression matching ftp \"success\" messages.")
;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
;; Also CMS machines use a multiline 550- reply to say that you
(concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
"^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye")
- "*Regular expression matching messages from the ftp process that can be
-ignored.")
+ "*Regular expression matching ftp messages that can be ignored.")
(defvar ange-ftp-fatal-msgs
(concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
"^No control connection\\|unknown host\\|^lost connection")
- "*Regular expression matching messages from the FTP process that indicate
-something has gone drastically wrong attempting the action that was
-initiated and that the FTP process should (or already has) been killed.")
+ "*Regular expression matching ftp messages that indicate serious errors.
+These mean that the FTP process should (or already has) been killed.")
(defvar ange-ftp-gateway-fatal-msgs
"No route to host\\|Connection closed\\|No such host\\|Login incorrect"
- "*Regular expression matching messages from the rlogin / telnet process that
-indicates that logging in to the gateway machine has gone wrong.")
+ "*Regular expression matching login failure messages from rlogin/telnet.")
(defvar ange-ftp-xfer-size-msgs
"^150 .* connection for .* (\\([0-9]+\\) bytes)"
If nil then prompt the user for a password.")
(defvar ange-ftp-dumb-unix-host-regexp nil
- "*If non-nil, if the host being ftp'd to matches this regexp then the FTP
-process uses the \'dir\' command to get directory information.")
+ "*If non-nil, regexp matching hosts on which `dir' command lists directory.")
(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
"*Name of host to use as gateway machine when local FTP isn't possible.")
(defvar ange-ftp-local-host-regexp ".*"
- "*If a host being FTP'd to matches this regexp then the ftp process is started
-locally, otherwise the FTP process is started on \`ange-ftp-gateway-host\'
+ "*Regexp selecting hosts which can be reached directly with ftp.
+For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
instead.")
(defvar ange-ftp-gateway-program-interactive nil
- "*If non-nil then the gateway program is expected to connect to the gateway
-machine and eventually give a shell prompt. Both telnet and rlogin do something
-like this.")
+ "*If non-nil then the gateway program should give a shell prompt.
+Both telnet and rlogin do something like this.")
(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
- "*Name of program to spawn a shell on the gateway machine. Valid candidates
-are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable
-above.")
+ "*Name of program to spawn a shell on the gateway machine.
+Valid candidates are rsh (remsh on hp-ux), telnet and rlogin. See
+also the gateway variable above.")
-(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *"
- "*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
+(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
+ "*Regexp matching prompt after complete login sequence on gateway machine.
+A match for this means the shell is now awaiting input. Make this regexp as
strict as possible; it shouldn't match *anything* at all except the user's
initial prompt. The above string will fail under most SUN-3's since it
matches the login banner.")
(if (eq system-type 'hpux)
"stty -onlcr -echo\n"
"stty -echo nl\n")
- "*Command to use after logging in to the gateway machine to stop the terminal
-echoing each command and to strip out trailing ^M characters.")
+ "*Set up terminal after logging in to the gateway machine.
+This command should stop the terminal from echoing each command, and
+arrange to strip out trailing ^M characters.")
(defvar ange-ftp-smart-gateway nil
- "*If the gateway FTP is smart enough to use proxy server, then don't bother
-telnetting etc, just issue a user@host command instead.")
+ "*Non-nil means the ftp gateway is smart.
+Don't bother telnetting, etc., just issue a user@host command instead.")
(defvar ange-ftp-smart-gateway-port "21"
"*Port on gateway machine to use when smart gateway is in operation.")
"*Non-nil means make backup files for \"magic\" remote files.")
(defvar ange-ftp-retry-time 5
- "*Number of seconds to wait before retrying if a file or listing
-doesn't arrive. This might need to be increased for very slow connections.")
+ "*Number of seconds to wait before retry if file or listing doesn't arrive.
+This might need to be increased for very slow connections.")
(defvar ange-ftp-auto-save 0
"If 1, allows ange-ftp files to be auto-saved.
;;;; Internal variables.
;;;; ------------------------------------------------------------
-(defconst ange-ftp-version "$Revision: 1.28 $")
+(defconst ange-ftp-version "$Revision: 1.50 $")
(defvar ange-ftp-data-buffer-name " *ftp data*"
"Buffer name to hold directory listing data received from ftp process.")
(concat (file-name-directory file) temp)))))
file)
+;; Move along current line looking for the value of the TOKEN.
+;; Valid separators between TOKEN and its value are commas and
+;; whitespace. Second arg LIMIT is a limit for the search.
+
(defun ange-ftp-parse-netrc-token (token limit)
- "Move along current line looking for the value of the TOKEN.
-Valid separators between TOKEN and its value are commas and
-whitespace. Second arg LIMIT is a limit for the search."
(if (search-forward token limit t)
(let (beg)
(skip-chars-forward ", \t\r\n" limit)
(skip-chars-forward "^, \t\r\n" limit)
(buffer-substring beg (point))))))
+;; Extract the values for the tokens `machine', `login',
+;; `password' and `account' in the current buffer. If successful,
+;; record the information found.
+
(defun ange-ftp-parse-netrc-group ()
- "Extract the values for the tokens \`machine\', \`login\', \`password\'
-and \`account\' in the current buffer. If successful, record the information
-found."
(beginning-of-line)
(let ((start (point))
(end (progn (re-search-forward "machine\\|default"
(setq ange-ftp-default-account account)))))
(goto-char end)))
-(defun ange-ftp-parse-netrc ()
- "Read in ~/.netrc, if one exists.
-If ~/.netrc file exists and has the correct permissions then extract the
-\`machine\', \`login\', \`password\' and \`account\' information from within."
+;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has
+;; the correct permissions then extract the \`machine\', \`login\',
+;; \`password\' and \`account\' information from within.
+(defun ange-ftp-parse-netrc ()
;; We set this before actually doing it to avoid the possibility
;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
(interactive)
(sit-for 1))
(setq ange-ftp-netrc-modtime (nth 5 attr))))))
+;; Return a list of prefixes of the form 'user@host:' to be used when
+;; completion is done in the root directory.
+
(defun ange-ftp-generate-root-prefixes ()
- "Return a list of prefixes of the form 'user@host:' to be used when
-completion is done in the root directory."
(ange-ftp-parse-netrc)
(ange-ftp-save-match-data
(let (res)
(defvar ange-ftp-ftp-name-arg "")
(defvar ange-ftp-ftp-name-res nil)
+;; Parse NAME according to `ange-ftp-name-format' (which see).
+;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
(defun ange-ftp-ftp-name (name)
- "Parse NAME according to `ange-ftp-name-format' (which see).
-Returns a list (HOST USER NAME), or nil if NAME does not match the format."
(if (string-equal name ange-ftp-ftp-name-arg)
ange-ftp-ftp-name-res
(setq ange-ftp-ftp-name-arg name
(list host user name))
nil)))))
+;; Take a FULLNAME that matches according to ange-ftp-name-format and
+;; replace the name component with NAME.
(defun ange-ftp-replace-name-component (fullname name)
- "Take a FULLNAME that matches according to ange-ftp-name-format and
-replace the name component with NAME."
(ange-ftp-save-match-data
(if (string-match (car ange-ftp-name-format) fullname)
(let* ((ns (cdr ange-ftp-name-format))
"Clear any existing minibuffer message; let the minibuffer contents show."
(message nil))
+;; Return the name of the buffer that collects output from the ftp process
+;; connected to the given HOST and USER pair.
(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 "*"))
+;; 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.
(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
;;;; ------------------------------------------------------------
(defun ange-ftp-process-handle-line (line proc)
- "Look at the given LINE from the ftp process PROC. Try to categorize it
-into one of four categories: good, skip, fatal, or unknown."
+ "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
(ash (string-to-int (substring line
(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-message "%s...%d%%" ange-ftp-process-msg percent)))))))
str)
+;; Call the function specified by CONT. CONT can be either a function
+;; or a list of a function and some args. The first two parameters
+;; passed to the function will be RESULT and LINE. The remaining args
+;; will be taken from CONT if a list was passed.
+
(defun ange-ftp-call-cont (cont result line)
- "Call the function specified by CONT. CONT can be either a function or a
-list of a function and some args. The first two parameters passed to the
-function will be RESULT and LINE. The remaining args will be taken from CONT
-if a list was passed."
(if cont
(if (and (listp cont)
(not (eq (car cont) 'lambda)))
(apply (car cont) result line (cdr cont))
(funcall cont result line))))
+;; Build up a complete line of output from the ftp PROCESS and pass it
+;; on to ange-ftp-process-handle-line to deal with.
+
(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."
(let ((buffer (process-buffer proc))
(old-buffer (current-buffer)))
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
(defun ange-ftp-gwp-start (host user name args)
"Login to the gateway machine and fire up an ftp process."
(let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
- (proc (start-process name name
- ange-ftp-gateway-program
- ange-ftp-gateway-host))
+ ;; It would be nice to make process-connection-type nil,
+ ;; but that doesn't work: ftp never responds.
+ ;; Can anyone find a fix for that?
+ (proc (let ((process-connection-type t))
+ (start-process name name
+ ange-ftp-gateway-program
+ ange-ftp-gateway-host)))
(ftp (mapconcat (function identity) args " ")))
(process-kill-without-query proc)
(set-process-sentinel proc (function ange-ftp-gwp-sentinel))
"Attempt to resolve the given HOSTNAME using nslookup if possible."
(interactive "sHost: ")
(if ange-ftp-nslookup-program
- (let ((proc (start-process " *nslookup*" " *nslookup*"
- ange-ftp-nslookup-program host))
+ (let ((default-directory
+ (if (file-accessible-directory-p default-directory)
+ default-directory
+ exec-directory))
+ ;; It would be nice to make process-connection-type nil,
+ ;; but that doesn't work: ftp never responds.
+ ;; Can anyone find a fix for that?
+ (proc (let ((process-connection-type t))
+ (start-process " *nslookup*" " *nslookup*"
+ ange-ftp-nslookup-program host)))
(res host))
(process-kill-without-query proc)
(save-excursion
ange-ftp-gateway-ftp-program-name
ange-ftp-ftp-program-name))
(args (append (list ftp-prog) ange-ftp-ftp-program-args))
+ ;; Without the following binding, ange-ftp-start-process
+ ;; recurses on file-accessible-directory-p, since it needs to
+ ;; restart its process in order to determine anything about
+ ;; default-directory.
+ (file-name-handler-alist)
+ (default-directory
+ (if (file-accessible-directory-p default-directory)
+ default-directory
+ exec-directory))
proc)
- (if use-gateway
- (if ange-ftp-gateway-program-interactive
- (setq proc (ange-ftp-gwp-start host user name args))
- (setq proc (apply 'start-process name name
- (append (list ange-ftp-gateway-program
- ange-ftp-gateway-host)
- args))))
- (setq proc (apply 'start-process name name args)))
+ ;; It would be nice to make process-connection-type nil,
+ ;; but that doesn't work: ftp never responds.
+ ;; Can anyone find a fix for that?
+ (let ((process-connection-type t))
+ (if use-gateway
+ (if ange-ftp-gateway-program-interactive
+ (setq proc (ange-ftp-gwp-start host user name args))
+ (setq proc (apply 'start-process name name
+ (append (list ange-ftp-gateway-program
+ ange-ftp-gateway-host)
+ args))))
+ (setq proc (apply 'start-process name name args))))
(process-kill-without-query proc)
(save-excursion
(set-buffer (process-buffer proc))
proc))
(defun internal-ange-ftp-mode ()
+ "Major mode for interacting with the FTP process.
+
+\\{comint-mode-map}"
(interactive)
(comint-mode)
(setq major-mode 'internal-ange-ftp-mode)
(make-local-variable 'ange-ftp-last-percent)
(setq ange-ftp-hash-mark-count 0)
(setq ange-ftp-xfer-size 0)
- (setq ange-ftp-process-result-line "")))
+ (setq ange-ftp-process-result-line "")
+
+ (setq comint-prompt-regexp "^ftp> ")
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start comint-prompt-regexp)))
(defun ange-ftp-smart-login (host user pass account proc)
"Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
(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.")
(setq ange-ftp-binary-hash-mark-size size)))))))))
(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 process if needed."
+ "Return an FTP subprocess connected to HOST and logged in as USER.
+Create a new process if needed."
(let* ((name (ange-ftp-ftp-process-buffer host user))
(proc (get-process name)))
(if (and proc (memq (process-status proc) '(run open)))
;; (for efficiency) if you log into a particular non-UNIX host frequently.
(defvar ange-ftp-fix-name-func-alist nil
- "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
+ "Alist saying how to convert file name to the host's syntax.
+Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
which can change a UNIX file name into a name more suitable for a host of type
TYPE.")
(defvar ange-ftp-fix-dir-name-func-alist nil
- "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
+ "Alist saying how to convert directory name to the host's syntax.
+Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
which can change UNIX directory name into a directory name more suitable
for a host of type TYPE.")
;; 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))
"^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
(defun ange-ftp-guess-host-type (host user)
- "Guess at the the host type of HOST by doing a pwd, and examining
-the directory syntax."
+ "Guess at the the host type of HOST.
+Works by doing a pwd and examining the directory syntax."
(let ((host-type (ange-ftp-host-type host))
(key (concat host "/" user "/~")))
(if (eq host-type 'unix)
;;;; Remote file and directory listing support.
;;;; ------------------------------------------------------------
+;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
+;; to take switch arguments.
(defun ange-ftp-dumb-unix-host (host)
- "Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
-to take switch arguments."
(and ange-ftp-dumb-unix-host-regexp
(ange-ftp-save-match-data
(string-match ange-ftp-dumb-unix-host-regexp host))))
ange-ftp-host-cache nil)))
(defvar ange-ftp-parse-list-func-alist nil
- "Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine
+ "Alist saying how to parse directory listings for certain OS types.
+Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine
which can parse the output from a DIR listing for a host of type TYPE.")
;; With no-error nil, this function returns:
"\\|Nov\\|Dec\\) +[0-3]?[0-9] "))
(defvar ange-ftp-add-file-entry-alist nil
- "Association list of pairs \( TYPE \. FUNC \), where FUNC
+ "Alist saying how to add file entries on certain OS types.
+Association list of pairs \( TYPE \. FUNC \), where FUNC
is a function to be used to add a file entry for the OS TYPE. The
main reason for this alist is to deal with file versions in VMS.")
(defvar ange-ftp-delete-file-entry-alist nil
- "Association list of pairs \( TYPE \. FUNC \), where FUNC
+ "Alist saying how to delete files on certain OS types.
+Association list of pairs \( TYPE \. FUNC \), where FUNC
is a function to be used to delete a file entry for the OS TYPE.
-The main reason for this alist is to deal with file versions in
-VMS.")
+The main reason for this alist is to deal with file versions in VMS.")
(defun ange-ftp-add-file-entry (name &optional dir-p)
"Add a file entry for file NAME, if its directory info exists."
;;; The dl stuff for descriptive listings
(defvar ange-ftp-dl-dir-regexp nil
- "Regexp matching directories which are listed in dl format. This regexp
-shouldn't be anchored with a trailing $ so that it will match subdirectories
-as well.")
+ "Regexp matching directories which are listed in dl format.
+This regexp should not be anchored with a trailing `$', because it should
+match subdirectories as well.")
(defun ange-ftp-add-dl-dir (dir)
"Interactively adds a DIR to ange-ftp-dl-dir-regexp."
(ange-ftp-put-hash-entry ".." t tbl)
tbl)))
+;; Parse the current buffer which is assumed to be in a dired-like listing
+;; format, and return a hashtable as the result. If the listing is not really
+;; a listing, then return nil.
+
(defun ange-ftp-parse-dired-listing (&optional switches)
- "Parse the current buffer which is assumed to be in a dired-like listing
-format, and return a hashtable as the result. If the listing is not really
-a listing, then return nil."
(ange-ftp-save-match-data
(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-get-hash-entry
directory ange-ftp-files-hashtable)))))
+;; Given NAME, return the file part that can be used for looking up the
+;; file's entry in a hashtable.
(defmacro ange-ftp-get-file-part (name)
- "Given NAME, return the file part that can be used for looking up the
-file's entry in a hashtable."
(` (let ((file (file-name-nondirectory (, name))))
(if (string-equal file "")
"."
file))))
+;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
+;; allowed to determine if NAME is a sub-directory by listing it directly,
+;; rather than listing its parent directory. This is used for efficiency so
+;; that a wasted listing is not done:
+;; 1. When looking for a .dired file in dired-x.el.
+;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
+;; subdirectory. This is of course an OS dependent judgement.
+
(defmacro ange-ftp-allow-child-lookup (dir file)
- "Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
-allowed to determine if NAME is a sub-directory by listing it directly,
-rather than listing its parent directory. This is used for efficiency so
-that a wasted listing is not done:
-1. When looking for a .dired file in dired-x.el.
-2. The syntax of FILE and DIR make it impossible that FILE could be a valid
- subdirectory. This is of course an OS dependent judgement."
(` (not
(let* ((efile (, file)) ; expand once.
(edir (, dir))
files))))
(defun ange-ftp-wipe-file-entries (host user)
- "Replace the file entry information hashtable with one that doesn't have any
-entries for the given HOST, USER pair."
+ "Get rid of entry for HOST, USER pair from file entry information hashtable."
(let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable))))
(ange-ftp-map-hashtable
(function
;;; ------------------------------------------------------------
(defun ange-ftp-expand-dir (host user dir)
- "Return the result of doing a PWD in the current FTP session to machine HOST
+ "Return the result of doing a PWD in the current FTP session.
+Use the connection to machine HOST
logged in as user USER and cd'd to directory DIR."
(let* ((host-type (ange-ftp-host-type host user))
;; It is more efficient to call ange-ftp-host-type
;;; These are problems--they are currently not enabled.
(defvar ange-ftp-file-name-as-directory-alist nil
- "Association list of \( TYPE \. FUNC \) pairs, where
+ "Association list of \( TYPE \. FUNC \) pairs.
FUNC converts a filename to a directory name for the operating
system TYPE.")
(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 beg end)
+(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
- beg end)))
+ (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 beg end))))
+ (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))
(format "Getting %s" fn1))
tmp1))))
-(defun ange-ftp-load (file)
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
(if (ange-ftp-ftp-name file)
- (let ((copy (ange-ftp-file-local-copy file)))
- (unwind-protect
- (load copy)
- (delete-file copy)))
- (ange-ftp-real-load 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)
(defun ange-ftp-hook-function (operation &rest args)
(let ((fn (get operation 'ange-ftp)))
(if fn (apply fn args)
- (let (file-name-handler-alist)
- (apply operation args)))))
+ (ange-ftp-run-real-handler operation args))))
;;; This regexp takes care of real ange-ftp file names (with a slash
-;;; and colon), and absolute filenames with only one component, for
-;;; the sake of hostname completion.
+;;; and colon).
;;;###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-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)
+ (setq file-name-handler-alist
+ (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)
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
+(defun ange-ftp-run-real-handler (operation args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ange-ftp-hook-function
+ (cons 'ange-ftp-completion-hook-function
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers))))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
+
(defun ange-ftp-real-file-name-directory (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-directory args)))
+ (ange-ftp-run-real-handler 'file-name-directory args))
(defun ange-ftp-real-file-name-nondirectory (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-nondirectory args)))
+ (ange-ftp-run-real-handler 'file-name-nondirectory args))
(defun ange-ftp-real-file-name-as-directory (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-as-directory args)))
+ (ange-ftp-run-real-handler 'file-name-as-directory args))
(defun ange-ftp-real-directory-file-name (&rest args)
- (let (file-name-handler-alist)
- (apply 'directory-file-name args)))
+ (ange-ftp-run-real-handler 'directory-file-name args))
(defun ange-ftp-real-expand-file-name (&rest args)
- (let (file-name-handler-alist)
- (apply 'expand-file-name args)))
+ (ange-ftp-run-real-handler 'expand-file-name args))
(defun ange-ftp-real-make-directory (&rest args)
- (let (file-name-handler-alist)
- (apply 'make-directory args)))
+ (ange-ftp-run-real-handler 'make-directory args))
(defun ange-ftp-real-delete-directory (&rest args)
- (let (file-name-handler-alist)
- (apply 'delete-directory args)))
+ (ange-ftp-run-real-handler 'delete-directory args))
(defun ange-ftp-real-insert-file-contents (&rest args)
- (let (file-name-handler-alist)
- (apply 'insert-file-contents args)))
+ (ange-ftp-run-real-handler 'insert-file-contents args))
(defun ange-ftp-real-directory-files (&rest args)
- (let (file-name-handler-alist)
- (apply 'directory-files args)))
+ (ange-ftp-run-real-handler 'directory-files args))
(defun ange-ftp-real-file-directory-p (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-directory-p args)))
+ (ange-ftp-run-real-handler 'file-directory-p args))
(defun ange-ftp-real-file-writable-p (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-writable-p args)))
+ (ange-ftp-run-real-handler 'file-writable-p args))
(defun ange-ftp-real-file-readable-p (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-readable-p args)))
+ (ange-ftp-run-real-handler 'file-readable-p args))
+(defun ange-ftp-real-file-executable-p (&rest args)
+ (ange-ftp-run-real-handler 'file-executable-p args))
(defun ange-ftp-real-file-symlink-p (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-symlink-p args)))
+ (ange-ftp-run-real-handler 'file-symlink-p args))
(defun ange-ftp-real-delete-file (&rest args)
- (let (file-name-handler-alist)
- (apply 'delete-file args)))
+ (ange-ftp-run-real-handler 'delete-file args))
(defun ange-ftp-real-read-file-name-internal (&rest args)
- (let (file-name-handler-alist)
- (apply 'read-file-name-internal args)))
+ (ange-ftp-run-real-handler 'read-file-name-internal args))
(defun ange-ftp-real-verify-visited-file-modtime (&rest args)
- (let (file-name-handler-alist)
- (apply 'verify-visited-file-modtime args)))
+ (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
(defun ange-ftp-real-file-exists-p (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-exists-p args)))
+ (ange-ftp-run-real-handler 'file-exists-p args))
(defun ange-ftp-real-write-region (&rest args)
- (let (file-name-handler-alist)
- (apply 'write-region args)))
+ (ange-ftp-run-real-handler 'write-region args))
(defun ange-ftp-real-backup-buffer (&rest args)
- (let (file-name-handler-alist)
- (apply 'backup-buffer args)))
+ (ange-ftp-run-real-handler 'backup-buffer args))
(defun ange-ftp-real-copy-file (&rest args)
- (let (file-name-handler-alist)
- (apply 'copy-file args)))
+ (ange-ftp-run-real-handler 'copy-file args))
(defun ange-ftp-real-rename-file (&rest args)
- (let (file-name-handler-alist)
- (apply 'rename-file args)))
+ (ange-ftp-run-real-handler 'rename-file args))
(defun ange-ftp-real-file-attributes (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-attributes args)))
+ (ange-ftp-run-real-handler 'file-attributes args))
(defun ange-ftp-real-file-name-all-completions (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-all-completions args)))
+ (ange-ftp-run-real-handler 'file-name-all-completions args))
(defun ange-ftp-real-file-name-completion (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-completion args)))
+ (ange-ftp-run-real-handler 'file-name-completion args))
(defun ange-ftp-real-insert-directory (&rest args)
- (let (file-name-handler-alist)
- (apply 'insert-directory args)))
+ (ange-ftp-run-real-handler 'insert-directory args))
(defun ange-ftp-real-file-name-sans-versions (&rest args)
- (let (file-name-handler-alist)
- (apply 'file-name-sans-versions args)))
+ (ange-ftp-run-real-handler 'file-name-sans-versions args))
(defun ange-ftp-real-shell-command (&rest args)
- (let (file-name-handler-alist)
- (apply 'shell-command args)))
+ (ange-ftp-run-real-handler 'shell-command args))
(defun ange-ftp-real-load (&rest args)
- (let (file-name-handler-alist)
- (apply 'load args)))
+ (ange-ftp-run-real-handler '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.")
(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