;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989,90,91,92,93,94,95,96 Free Software Foundation, Inc.
+;; Copyright (C) 1989,90,91,92,93,94,95,96,98 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
;;; Code:
(require 'comint)
+;; Silence compiler:
+(eval-when-compile
+ (defvar comint-last-output-start nil)
+ (defvar comint-last-input-start nil)
+ (defvar comint-last-input-end nil))
;;;; ------------------------------------------------------------
;;;; User customization variables.
;;;; ------------------------------------------------------------
-(defvar ange-ftp-name-format
+(defgroup ange-ftp nil
+ "Accessing remote files and directories using FTP
+ made as simple and transparent as possible."
+ :group 'files
+ :prefix "ange-ftp-")
+
+(defcustom ange-ftp-name-format
'("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
"*Format of a fully expanded remote file name.
+
This is a list of the form \(REGEXP HOST USER NAME\),
where REGEXP is a regular expression matching
the full remote name, and HOST, USER, and NAME are the numbers of
-parenthesized expressions in REGEXP for the components (in that order).")
+parenthesized expressions in REGEXP for the components (in that order)."
+ :group 'ange-ftp
+ :type '(list regexp
+ (integer :tag "Host group")
+ (integer :tag "User group")
+ (integer :tag "Name group")))
;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
;; mode and hangs. Have it ignore 550- instead. It will then barf
;; when it gets the 550 line, as it should.
-(defvar ange-ftp-skip-msgs
+(defcustom ange-ftp-skip-msgs
(concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
"^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^227 .*[Pp]assive")
- "*Regular expression matching ftp messages that can be ignored.")
+ "*Regular expression matching ftp messages that can be ignored."
+ :group 'ange-ftp
+ :type 'regexp)
-(defvar ange-ftp-fatal-msgs
+(defcustom ange-ftp-fatal-msgs
(concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
"^No control connection\\|unknown host\\|^lost connection")
"*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
+These mean that the FTP process should (or already has) been killed."
+ :group 'ange-ftp
+ :type 'regexp)
+
+(defcustom ange-ftp-gateway-fatal-msgs
"No route to host\\|Connection closed\\|No such host\\|Login incorrect"
- "*Regular expression matching login failure messages from rlogin/telnet.")
+ "*Regular expression matching login failure messages from rlogin/telnet."
+ :group 'ange-ftp
+ :type 'regexp)
-(defvar ange-ftp-xfer-size-msgs
+(defcustom ange-ftp-xfer-size-msgs
"^150 .* connection for .* (\\([0-9]+\\) bytes)"
- "*Regular expression used to determine the number of bytes in a FTP transfer.")
+ "*Regular expression used to determine the number of bytes in a FTP transfer."
+ :group 'ange-ftp
+ :type 'regexp)
-(defvar ange-ftp-tmp-name-template "/tmp/ange-ftp"
- "*Template used to create temporary files.")
+(defcustom ange-ftp-tmp-name-template
+ (expand-file-name "ange-ftp" temporary-file-directory)
+ "*Template used to create temporary files."
+ :group 'ange-ftp
+ :type 'directory)
-(defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
+(defcustom ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
"*Template used to create temporary files when ftp-ing through a gateway.
+
Files starting with this prefix need to be accessible from BOTH the local
machine and the gateway machine, and need to have the SAME name on both
machines, that is, /tmp is probably NOT what you want, since that is rarely
-cross-mounted.")
+cross-mounted."
+ :group 'ange-ftp
+ :type 'directory)
-(defvar ange-ftp-netrc-filename "~/.netrc"
- "*File in .netrc format to search for passwords.")
+(defcustom ange-ftp-netrc-filename "~/.netrc"
+ "*File in .netrc format to search for passwords."
+ :group 'ange-ftp
+ :type 'file)
-(defvar ange-ftp-disable-netrc-security-check nil
- "*If non-nil avoid checking permissions on the .netrc file.")
+(defcustom ange-ftp-disable-netrc-security-check nil
+ "*If non-nil avoid checking permissions on the .netrc file."
+ :group 'ange-ftp
+ :type 'boolean)
-(defvar ange-ftp-default-user nil
+(defcustom ange-ftp-default-user nil
"*User name to use when none is specified in a file name.
+
If non-nil but not a string, you are prompted for the name.
If nil, the value of `ange-ftp-netrc-default-user' is used.
If that is nil too, then your login name is used.
Once a connection to a given host has been initiated, the user name
and password information for that host are cached and re-used by
-ange-ftp. Use `ange-ftp-set-user' to change the cached values,
+ange-ftp. Use \\[ange-ftp-set-user] to change the cached values,
since setting `ange-ftp-default-user' directly does not affect
-the cached information.")
+the cached information."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ (const :tag "Prompt" t)
+ string))
-(defvar ange-ftp-netrc-default-user nil
+(defcustom ange-ftp-netrc-default-user nil
"Alternate default user name to use when none is specified.
-This variable is set from the `default' command in your `.netrc' file,
-if there is one.")
-
-(defvar ange-ftp-default-password nil
- "*Password to use when the user name equals `ange-ftp-default-user'.")
-
-(defvar ange-ftp-default-account nil
- "*Account to use when the user name equals `ange-ftp-default-user'.")
-
-(defvar ange-ftp-netrc-default-password nil
- "*Password to use when the user name equals `ange-ftp-netrc-default-user'.")
-
-(defvar ange-ftp-netrc-default-account nil
- "*Account to use when the user name equals `ange-ftp-netrc-default-user'.")
-(defvar ange-ftp-generate-anonymous-password t
+This variable is set from the `default' command in your `.netrc' file,
+if there is one."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-default-password nil
+ "*Password to use when the user name equals `ange-ftp-default-user'."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-default-account nil
+ "*Account to use when the user name equals `ange-ftp-default-user'."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-netrc-default-password nil
+ "*Password to use when the user name equals `ange-ftp-netrc-default-user'."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-netrc-default-account nil
+ "*Account to use when the user name equals `ange-ftp-netrc-default-user'."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-generate-anonymous-password t
"*If t, use value of `user-mail-address' as password for anonymous ftp.
-If a string, then use that string as the password.
-If nil, prompt the user for a password.")
-
-(defvar ange-ftp-dumb-unix-host-regexp nil
- "*If non-nil, regexp matching hosts on which `dir' command lists directory.")
-(defvar ange-ftp-binary-file-name-regexp
+If a string, then use that string as the password.
+If nil, prompt the user for a password."
+ :group 'ange-ftp
+ :type '(choice (const :tag "User address" t)
+ (const :tag "Prompt" nil)
+ string))
+
+(defcustom ange-ftp-dumb-unix-host-regexp nil
+ "*If non-nil, regexp matching hosts on which `dir' command lists directory."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
+
+(defcustom ange-ftp-binary-file-name-regexp
(concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
"\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
"\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|"
"\\.taz$\\|\\.tgz$")
- "*If a file matches this regexp then it is transferred in binary mode.")
+ "*If a file matches this regexp then it is transferred in binary mode."
+ :group 'ange-ftp
+ :type 'regexp)
-(defvar ange-ftp-gateway-host nil
- "*Name of host to use as gateway machine when local FTP isn't possible.")
+(defcustom ange-ftp-gateway-host nil
+ "*Name of host to use as gateway machine when local FTP isn't possible."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Default" nil)
+ string))
-(defvar ange-ftp-local-host-regexp ".*"
+(defcustom ange-ftp-local-host-regexp ".*"
"*Regexp selecting hosts which can be reached directly with ftp.
+
For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
-instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'.")
+instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'."
+ :group 'ange-ftp
+ :type 'regexp)
-(defvar ange-ftp-gateway-program-interactive nil
+(defcustom ange-ftp-gateway-program-interactive nil
"*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 remote-shell-program
+Both telnet and rlogin do something like this."
+ :group 'ange-ftp
+ :type 'boolean)
+
+(defcustom ange-ftp-gateway-program remote-shell-program
"*Name of program to spawn a shell on the gateway machine.
-Valid candidates are rsh (remsh on some systems), telnet and rlogin. See
-also the gateway variable above.")
-(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
+Valid candidates are rsh (remsh on some systems), telnet and rlogin. See
+also the gateway variable above."
+ :group 'ange-ftp
+ :type '(choice (const "rsh")
+ (const "telnet")
+ (const "rlogin")
+ string))
+
+(defcustom 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.")
+matches the login banner."
+ :group 'ange-ftp
+ :type 'regexp)
(defvar ange-ftp-gateway-setup-term-command
(if (eq system-type 'hpux)
This command should stop the terminal from echoing each command, and
arrange to strip out trailing ^M characters.")
-(defvar ange-ftp-smart-gateway nil
+(defcustom ange-ftp-smart-gateway nil
"*Non-nil means the ftp gateway and/or the gateway ftp program is smart.
+
Don't bother telnetting, etc., already connected to desired host transparently,
-or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.")
+or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil."
+ :group 'ange-ftp
+ :type 'boolean)
-(defvar ange-ftp-smart-gateway-port "21"
- "*Port on gateway machine to use when smart gateway is in operation.")
+(defcustom ange-ftp-smart-gateway-port "21"
+ "*Port on gateway machine to use when smart gateway is in operation."
+ :group 'ange-ftp
+ :type 'string)
-(defvar ange-ftp-send-hash t
- "*If non-nil, send the HASH command to the FTP client.")
+(defcustom ange-ftp-send-hash t
+ "*If non-nil, send the HASH command to the FTP client."
+ :group 'ange-ftp
+ :type 'boolean)
-(defvar ange-ftp-binary-hash-mark-size nil
+(defcustom ange-ftp-binary-hash-mark-size nil
"*Default size, in bytes, between hash-marks when transferring a binary file.
-If NIL, this variable will be locally overridden if the FTP client outputs a
-suitable response to the HASH command. If non-NIL then this value takes
-precedence over the local value.")
-
-(defvar ange-ftp-ascii-hash-mark-size 1024
+If nil, this variable will be locally overridden if the FTP client outputs a
+suitable response to the HASH command. If non-nil, this value takes
+precedence over the local value."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Overridden" nil)
+ integer))
+
+(defcustom ange-ftp-ascii-hash-mark-size 1024
"*Default size, in bytes, between hash-marks when transferring an ASCII file.
This variable is buffer-local and will be locally overridden if the FTP client
-outputs a suitable response to the HASH command.")
+outputs a suitable response to the HASH command."
+ :group 'ange-ftp
+ :type 'integer)
-(defvar ange-ftp-process-verbose t
- "*If non-NIL then be chatty about interaction with the FTP process.")
+(defcustom ange-ftp-process-verbose t
+ "*If non-nil then be chatty about interaction with the FTP process."
+ :group 'ange-ftp
+ :type 'boolean)
-(defvar ange-ftp-ftp-program-name "ftp"
- "*Name of FTP program to run.")
+(defcustom ange-ftp-ftp-program-name "ftp"
+ "*Name of FTP program to run."
+ :group 'ange-ftp
+ :type 'string)
-(defvar ange-ftp-gateway-ftp-program-name "ftp"
+(defcustom ange-ftp-gateway-ftp-program-name "ftp"
"*Name of FTP program to run when accessing non-local hosts.
-Some AT&T folks claim to use something called `pftp' here.")
-(defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
- "*A list of arguments passed to the FTP program when started.")
+Some AT&T folks claim to use something called `pftp' here."
+ :group 'ange-ftp
+ :type 'string)
-(defvar ange-ftp-nslookup-program nil
- "*If non-NIL then a string naming nslookup program." )
+(defcustom ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
+ "*A list of arguments passed to the FTP program when started."
+ :group 'ange-ftp
+ :type '(repeat string))
-(defvar ange-ftp-make-backup-files ()
- "*Non-nil means make backup files for \"magic\" remote files.")
+(defcustom ange-ftp-nslookup-program nil
+ "*If non-nil, this is a string naming the nslookup program."
+ :group 'ange-ftp
+ :type '(choice (const :tag "None" nil)
+ string))
-(defvar ange-ftp-retry-time 5
- "*Number of seconds to wait before retry if file or listing doesn't arrive.
-This might need to be increased for very slow connections.")
+(defcustom ange-ftp-make-backup-files ()
+ "*Non-nil means make backup files for \"magic\" remote files."
+ :group 'ange-ftp
+ :type 'boolean)
-(defvar ange-ftp-auto-save 0
- "If 1, allows ange-ftp files to be auto-saved.
-If 0, suppresses auto-saving of ange-ftp files.
-Don't use any other value.")
+(defcustom ange-ftp-retry-time 5
+ "*Number of seconds to wait before retry if file or listing doesn't arrive.
+This might need to be increased for very slow connections."
+ :group 'ange-ftp
+ :type 'integer)
+
+(defcustom ange-ftp-auto-save 0
+ "If 1, allow ange-ftp files to be auto-saved.
+If 0, inhibit auto-saving of ange-ftp files.
+Don't use any other value."
+ :group 'ange-ftp
+ :type '(choice (const :tag "Suppress" 0)
+ (const :tag "Allow" 1)))
\f
;;;; ------------------------------------------------------------
;;;; Hash table support.
"Hash table holding associations between HOST, USER pairs.")
(defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
- "Mapping between a HOST, USER pair and a PASSWORD for them.")
+ "Mapping between a HOST, USER pair and a PASSWORD for them.
+All HOST values should be in lower case.")
(defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable)
"Mapping between a HOST, USER pair and a ACCOUNT password for them.")
(defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97)
"Hash table for storing directories and their respective files.")
+(defvar ange-ftp-inodes-hashtable (ange-ftp-make-hashtable 97)
+ "Hash table for storing file names and their \"inode numbers\".")
+
+(defvar ange-ftp-next-inode-number 1
+ "Next \"inode number\" value. We give each file name a unique number.")
+
(defvar ange-ftp-ls-cache-lsargs nil
"Last set of args used by ange-ftp-ls.")
(or pass default "")))
(defmacro ange-ftp-generate-passwd-key (host user)
- (` (concat (, host) "/" (, user))))
+ (` (concat (downcase (, host)) "/" (, user))))
(defmacro ange-ftp-lookup-passwd (host user)
(` (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key (, host) (, user))
(if (looking-at "machine\\>")
;; Skip `machine' and the machine name that follows.
(progn
- (skip-chars-forward "^ \t\n")
- (skip-chars-forward " \t\n")
- (skip-chars-forward "^ \t\n"))
+ (skip-chars-forward "^ \t\r\n")
+ (skip-chars-forward " \t\r\n")
+ (skip-chars-forward "^ \t\r\n"))
;; Skip `default'.
- (skip-chars-forward "^ \t\n"))
+ (skip-chars-forward "^ \t\r\n"))
;; Find start of the next `machine' or `default'
;; or the end of the buffer.
(if (re-search-forward "machine\\>\\|default\\>" nil t)
(mapcar 'funcall find-file-hooks)
(setq buffer-file-name nil)
(goto-char (point-min))
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\r\n")
(while (not (eobp))
(ange-ftp-parse-netrc-group))
(kill-buffer (current-buffer)))
(if parsed
(let ((host (nth 0 parsed))
(user (nth 1 parsed)))
- (kill-buffer (ange-ftp-ftp-process-buffer host user))))))))
+ (kill-buffer (get-buffer (ange-ftp-ftp-process-buffer host user)))))))))
(defun ange-ftp-quote-string (string)
"Quote any characters in STRING that may confuse the ftp process."
(apply (function concat)
(mapcar (function
+ ;; This is said to be wrong; ftp is said to
+ ;; need quoting only for ", and that by doubling it.
+ ;; But experiment says this kind of quoting is correct
+ ;; when talking to ftp on GNU/Linux systems.
(lambda (char)
(if (or (<= char ? )
(> char ?\~)
(set-process-filter proc (function ange-ftp-gwp-filter))
(save-excursion
(set-buffer (process-buffer proc))
- (internal-ange-ftp-mode)
+ (goto-char (point-max))
(set-marker (process-mark proc) (point)))
(setq ange-ftp-gwp-running t
ange-ftp-gwp-status nil)
(defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
"Low-level routine to send the given ftp CMD to the ftp PROCESS.
MSG is an optional message to output before and after the command.
-If CONT is non-NIL then it is either a function or a list of function and
+If CONT is non-nil then it is either a function or a list of function and
some arguments. The function will be called when the ftp command has completed.
-If CONT is NIL then this routine will return \( RESULT . LINE \) where RESULT
+If CONT is nil then this routine will return \( RESULT . LINE \) where RESULT
is whether the command was successful, and LINE is the line from the FTP
process that caused the command to complete.
If NOWAIT is given then the routine will return immediately the command has
;; but that doesn't work: ftp never responds.
;; Can anyone find a fix for that?
(let ((process-connection-type t)
- (process-environment process-environment))
+ (process-environment process-environment)
+ (buffer (get-buffer-create name)))
+ (save-excursion
+ (set-buffer buffer)
+ (internal-ange-ftp-mode))
;; This tells GNU ftp not to output any fancy escape sequences.
(setenv "TERM" "dumb")
(if use-gateway
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))
- (internal-ange-ftp-mode))
+ (goto-char (point-max))
+ (set-marker (process-mark proc) (point)))
+ (process-kill-without-query proc)
(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
+ ;; wait for ftp startup message
+ (if (not (eq system-type 'windows-nt))
+ (accept-process-output proc)
+ ;; On Windows, the standard ftp client behaves a little oddly,
+ ;; initially buffering its output (because stdin/out are pipe
+ ;; handles). As a result, the startup message doesn't appear
+ ;; until enough output is generated to flush stdout, so a plain
+ ;; accept-process-output call at this point would hang
+ ;; indefinitely. So if nothing appears within 2 seconds, we try
+ ;; sending an innocuous command ("help foo") that forces some
+ ;; output. Curiously, once we start sending normal commands, the
+ ;; output no longer appears to be buffered, and everything works
+ ;; correctly (or at least appears to!).
+ (if (accept-process-output proc 2)
+ nil
+ (process-send-string proc "help foo\n")
+ (accept-process-output proc)))
proc))
+(put 'internal-ange-ftp-mode 'mode-class 'special)
+
(defun internal-ange-ftp-mode ()
"Major mode for interacting with the FTP process.
(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))
(make-local-variable 'ange-ftp-process-string)
(setq ange-ftp-process-string "")
(make-local-variable 'ange-ftp-process-busy)
(proc (get-process name)))
(if (and proc (memq (process-status proc) '(run open)))
proc
+ ;; Must delete dead process so that new process can reuse the name.
+ (if proc (delete-process proc))
(let ((pass (ange-ftp-quote-string
(ange-ftp-get-passwd host user)))
(account (ange-ftp-quote-string
;;;; ------------------------------------------------------------
(defconst ange-ftp-date-regexp
- " [A-Za-z\xa0-\xff][A-Za-z\xa0-\xff][A-Za-z\xa0-\xff] [0-3 ][0-9] "
- "Regular expression to recognize the date in a directory listing.
-This regular expression is designed to recognize month names
+ (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be padded on the right with spaces.
+ (month (concat l l "+ *"))
+ ;; Recognize any non-ASCII character.
+ ;; The purpose is to match a Kanji character.
+ (k "[^\0-\177]")
+ (s " ")
+ (mm "[ 0-1][0-9]")
+ (dd "[ 0-3][0-9]")
+ (western (concat "\\(" month s dd "\\|" dd s month "\\)"))
+ (japanese (concat mm k s dd k)))
+ ;; Require the previous column to end in a digit.
+ ;; This avoids recognizing `1 may 1997' as a date in the line:
+ ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
+ (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
+ "Regular expression to match up to the column before the file name in a
+directory listing. This regular expression is designed to recognize dates
regardless of the language.")
(defvar ange-ftp-add-file-entry-alist nil
;; will simply send back the ls
;; error message.
(ange-ftp-get-hash-entry "." ent))
- ;; Child lookup failed. Try the parent. If this bombs,
- ;; we are at wits end -- signal an error.
- ;; Problem: If this signals an error, the error message
- ;; may not have a lot to do with what went wrong.
- (ange-ftp-hash-entry-exists-p file
- (ange-ftp-get-files dir))))))
+ ;; Child lookup failed, so try the parent.
+ (let ((table (ange-ftp-get-files dir)))
+ ;; If the dir doesn't exist, don't use it as a hash table.
+ (and table
+ (ange-ftp-hash-entry-exists-p file
+ table)))))))
(defun ange-ftp-get-file-entry (name)
"Given NAME, return the given file entry.
(defun ange-ftp-get-pwd (host user)
"Attempts to get the current working directory for the given HOST/USER pair.
-Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
+Returns \( DIR . LINE \) where DIR is either the directory or nil if not found,
and LINE is the relevant success or fail line from the FTP-client."
(let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
(line (cdr result))
(ange-ftp-real-expand-file-name name))
((eq (string-to-char name) ?/)
(ange-ftp-canonize-filename name))
+ ((and (eq system-type 'windows-nt) (string-match "^[a-zA-Z]:" name))
+ name) ; when on local drive, return it as-is
((zerop (length name))
(ange-ftp-canonize-filename (or default default-directory)))
((ange-ftp-canonize-filename
(user (nth 1 parsed))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
+ ;; What we REALLY need here is a way to determine if the mode
+ ;; of the transfer is irrelevant, i.e. we can use binary mode
+ ;; regardless. Maybe a system-type to host-type lookup?
(binary (or (ange-ftp-binary-file filename)
- (eq (ange-ftp-host-type host user) 'unix)))
+ (and (not (eq system-type 'windows-nt))
+ (eq (ange-ftp-host-type host user) 'unix))))
(cmd (if append 'append 'put))
(abbr (ange-ftp-abbreviate-filename filename)))
(unwind-protect
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
(binary (or (ange-ftp-binary-file filename)
- (eq (ange-ftp-host-type host user) 'unix)))
+ (and (not (eq system-type 'windows-nt))
+ (eq (ange-ftp-host-type host user) 'unix))))
(abbr (ange-ftp-abbreviate-filename filename))
size)
(unwind-protect
(setq
size
(nth 1 (ange-ftp-real-insert-file-contents
- temp visit beg end replace)))
+ temp visit beg end replace))
+ ;; override autodetection of buffer file type
+ ;; to ensure buffer is saved in DOS format
+ buffer-file-type binary)
(signal 'ftp-error
(list
"Opening input file:"
(let ((host (nth 0 parsed))
(user (nth 1 parsed))
(name (nth 2 parsed))
- (dirp (ange-ftp-get-hash-entry part files)))
+ (dirp (ange-ftp-get-hash-entry part files))
+ (inode (ange-ftp-get-hash-entry
+ file ange-ftp-inodes-hashtable)))
+ (unless inode
+ (setq inode ange-ftp-next-inode-number
+ ange-ftp-next-inode-number (1+ inode))
+ (ange-ftp-put-hash-entry file inode ange-ftp-inodes-hashtable))
(list (if (and (stringp dirp) (file-name-absolute-p dirp))
(ange-ftp-expand-symlink dirp
(file-name-directory file))
(concat (if (stringp dirp) "l" (if dirp "d" "-"))
"?????????") ;8 mode
nil ;9 gid weird
- ;; Hack to give remote files a unique "inode number".
- ;; It's actually the sum of the characters in its name.
- (apply '+ (nconc (mapcar 'identity host)
- (mapcar 'identity user)
- (mapcar 'identity
- (directory-file-name name))))
+ inode ;10 "inode number".
-1 ;11 device number [v19 only]
))))
(ange-ftp-real-file-attributes file))))
(t-abbr (ange-ftp-abbreviate-filename newname filename))
(binary (or (ange-ftp-binary-file filename)
(ange-ftp-binary-file newname)
- (and (eq (ange-ftp-host-type f-host f-user) 'unix)
+ (and (not (eq system-type 'windows-nt))
+ (eq (ange-ftp-host-type f-host f-user) 'unix)
(eq (ange-ftp-host-type t-host t-user) 'unix))))
temp1
temp2)
file))))
completions)))
- (if (string-equal "/" ange-ftp-this-dir)
+ (if (or (and (eq system-type 'windows-nt)
+ (string-match "[^a-zA-Z]?[a-zA-Z]:[/\]" ange-ftp-this-dir))
+ (string-equal "/" ange-ftp-this-dir))
(nconc (all-completions file (ange-ftp-generate-root-prefixes))
(ange-ftp-real-file-name-all-completions file
ange-ftp-this-dir))
(funcall 'load copy noerror nomessage nosuffix)
(delete-file copy))
(or noerror
- (signal 'file-error (list "Cannot open load file" file)))))
+ (signal 'file-error (list "Cannot open load file" file)))
+ nil))
(ange-ftp-real-load file noerror nomessage nosuffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
file-name-handler-alist)))
+;;; Real ange-ftp file names prefixed with a drive letter.
+;;;###autoload
+(and (memq system-type '(ms-dos windows-nt))
+ (or (assoc "^[a-zA-Z]:/[^/:]*[^/:.]:" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^[a-zA-Z]:/[^/:]*[^/:.]:" . 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
(cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
file-name-handler-alist)))
+;;; Absolute file names prefixed with a drive letter.
+;;;###autoload
+(and (memq system-type '(ms-dos windows-nt))
+ (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^[a-zA-Z]:/[^/:]*\\'" .
+ ange-ftp-completion-hook-function)
+ file-name-handler-alist))))
+
;;; The above two forms are sufficient to cause this file to be loaded
;;; if the user ever uses a file name with a colon in it.
(put 'vc-registered 'ange-ftp 'null)
(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
+(put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
\f
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
(ange-ftp-run-real-handler 'file-name-as-directory args))
(defun ange-ftp-real-directory-file-name (&rest args)
(ange-ftp-run-real-handler 'directory-file-name args))
+(or (and (eq system-type 'windows-nt)
+ ;; Windows handler for [A-Z]: drive name on local disks
+ (defun ange-ftp-real-expand-file-name (&rest args)
+ (ange-ftp-run-real-handler 'ange-ftp-real-expand-file-name-actual args)))
(defun ange-ftp-real-expand-file-name (&rest args)
- (ange-ftp-run-real-handler 'expand-file-name args))
+ (ange-ftp-run-real-handler 'expand-file-name args)))
(defun ange-ftp-real-make-directory (&rest args)
(ange-ftp-run-real-handler 'make-directory args))
(defun ange-ftp-real-delete-directory (&rest args)
(if func (funcall func file keep-backup-version)
(ange-ftp-real-file-name-sans-versions file keep-backup-version))))
-;;; This doesn't work yet; a new hook needs to be created.
-;;; Maybe the new hook should be in call-process.
-(defun ange-ftp-shell-command (command)
+;; This is the handler for shell-command.
+(defun ange-ftp-shell-command (command &optional output-buffer)
(let* ((parsed (ange-ftp-ftp-name default-directory))
(host (nth 0 parsed))
(user (nth 1 parsed))
(name (nth 2 parsed)))
(if (not parsed)
- (ange-ftp-real-shell-command command)
+ (ange-ftp-real-shell-command command output-buffer)
(if (> (length name) 0) ; else it's $HOME
(setq command (concat "cd " name "; " command)))
(setq command
;; Cannot call ange-ftp-real-dired-run-shell-command here as it
;; would prepend "cd default-directory" --- which bombs because
;; default-directory is in ange-ftp syntax for remote file names.
- (ange-ftp-real-shell-command command))))
+ (ange-ftp-real-shell-command command output-buffer))))
;;; This is the handler for call-process.
(defun ange-ftp-dired-call-process (program discard &rest arguments)
;; Can't use ange-ftp-dired-host-type here because the current
;; buffer is *dired-check-process output*
(condition-case oops
- (cond ((equal "chmod" program)
+ (cond ((equal dired-chmod-program program)
(ange-ftp-call-chmod arguments))
;; ((equal "chgrp" program))
;; ((equal dired-chown-program program))
(defun ange-ftp-call-chmod (args)
(if (< (length args) 2)
(error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
- (let ((mode (car args)))
+ (let ((mode (car args))
+ (rest (cdr args)))
+ (if (equal "--" (car rest))
+ (setq rest (cdr rest)))
(mapcar
(function
(lambda (file)
(or (car result)
(call-process
ange-ftp-remote-shell
- nil t nil host "chmod" mode name)))))))
- (cdr args)))
+ nil t nil host dired-chmod-program mode name)))))))
+ rest))
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
0)
\f
;; (setq ange-ftp-dired-get-filename-alist
;; (cons '(cms . ange-ftp-dired-cms-get-filename)
;; ange-ftp-dired-get-filename-alist)))
+\f
+;;
+(and (eq system-type 'windows-nt)
+ (setq ange-ftp-disable-netrc-security-check t))
+
+;; If a drive letter has been added, remote it. Otherwise, if the drive
+;; letter existed before, leave it.
+(defun ange-ftp-real-expand-file-name-actual (&rest args)
+ (let (old-name new-name final drive-letter)
+ (setq old-name (car args))
+ (setq new-name (ange-ftp-run-real-handler 'expand-file-name args))
+ (setq drive-letter (substring new-name 0 2))
+ ;; I'd like to distill the following lines into one (if) statement
+ ;; removing the need for the temp final variable
+ (setq final new-name)
+ (if (not (equal (substring old-name 0 1) "~"))
+ (if (or (< (length old-name) 2)
+ (not (string-match "/[a-zA-Z]:" old-name)))
+ (setq final (substring new-name 2))))
+ final))
+
\f
;;;; ------------------------------------------------------------
;;;; Finally provide package.