:group 'ange-ftp
:type 'file)
-(defcustom ange-ftp-disable-netrc-security-check nil
+(defcustom ange-ftp-disable-netrc-security-check (eq system-type 'windows-nt)
"*If non-nil avoid checking permissions on the .netrc file."
:group 'ange-ftp
:type 'boolean)
the cached information."
:group 'ange-ftp
:type '(choice (const :tag "Default" nil)
- (const :tag "Prompt" t)
- string))
+ string
+ (other :tag "Prompt" t)))
(defcustom ange-ftp-netrc-default-user nil
"Alternate default user name to use when none is specified.
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))
+ :type '(choice (const :tag "Prompt" nil)
+ string
+ (other :tag "User address" t)))
(defcustom ange-ftp-dumb-unix-host-regexp nil
"*If non-nil, regexp matching hosts on which `dir' command lists directory."
(process-kill-without-query proc)
(set-process-sentinel proc (function ange-ftp-process-sentinel))
(set-process-filter proc (function ange-ftp-process-filter))
- ;; 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)))
+ ;; On Windows, the standard ftp client buffers its output (because
+ ;; stdout is a pipe handle) so the startup message may never appear:
+ ;; `accept-process-output' at this point would hang indefinitely.
+ ;; However, sending an innocuous command ("help foo") forces some
+ ;; output that will be ignored, which is just as good. Once we
+ ;; start sending normal commands, the output no longer appears to be
+ ;; buffered, and everything works correctly. My guess is that the
+ ;; output of interest is being sent to stderr which is not buffered.
+ (when (eq system-type 'windows-nt)
+ ;; force ftp output to be treated as DOS text, otherwise the
+ ;; output of "help foo" confuses the EOL detection logic.
+ (set-process-coding-system proc 'raw-text-dos)
+ (process-send-string proc "help foo\n"))
+ (accept-process-output proc) ;wait for ftp startup message
proc))
(put 'internal-ange-ftp-mode 'mode-class 'special)
(string-match "/$" cmd1)
(not (string-match "R" cmd3))
(setq cmd1 (concat cmd1 ".")))
+
+ ;; If the dir name contains a space, some ftp servers will
+ ;; refuse to list it. We instead change directory to the
+ ;; directory in question and ls ".".
+ (when (string-match " " cmd1)
+ (ange-ftp-cd host user (nth 1 cmd))
+ (setq cmd1 "."))
+
;; If the remote ls can take switches, put them in
(or (memq host-type ange-ftp-dumb-host-types)
(setq cmd0 'ls
"\\|"
ange-ftp-good-msgs))
(result (ange-ftp-send-cmd host user
- (list 'get dir "/dev/null")
+ (list 'get dir null-device)
(format "expanding %s" dir)))
(line (cdr result)))
(setq res
(if (not (string-match "^//" name))
(progn
(setq name (ange-ftp-real-expand-file-name name))
-
+ ;; Strip off drive specifier added on windows-nt
+ (if (and (eq system-type 'windows-nt)
+ (string-match "^[a-zA-Z]:" name))
+ (setq name (substring name 2)))
(if (string-match "^//" name)
(setq name (substring name 1)))))
(defun ange-ftp-expand-file-name (name &optional default)
"Documented as original."
(save-match-data
- (if (eq (string-to-char name) ?/)
- (while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users
- (setq name (substring name (1- (match-end 0)))))
- ((string-match "/~" name)
- (setq name (substring name (1- (match-end 0))))))))
+ (setq default (or default default-directory))
(cond ((eq (string-to-char name) ?~)
(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
+ ((and (eq system-type 'windows-nt)
+ (or (string-match "^[a-zA-Z]:" name)
+ (string-match "^[a-zA-Z]:" default)))
+ (ange-ftp-real-expand-file-name name default))
((zerop (length name))
- (ange-ftp-canonize-filename (or default default-directory)))
+ (ange-ftp-canonize-filename default))
((ange-ftp-canonize-filename
- (concat (file-name-as-directory (or default default-directory))
- name))))))
+ (concat (file-name-as-directory default) name))))))
\f
;;; These are problems--they are currently not enabled.
;; 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)
- (and (not (eq system-type 'windows-nt))
- (eq (ange-ftp-host-type host user) 'unix))))
+ (eq (ange-ftp-host-type host user) 'unix)))
(cmd (if append 'append 'put))
- (abbr (ange-ftp-abbreviate-filename filename)))
+ (abbr (ange-ftp-abbreviate-filename filename))
+ ;; we need to reset `last-coding-system-used' to its
+ ;; value immediately after calling the real write-region,
+ ;; so that `basic-save-buffer' doesn't see whatever value
+ ;; might be used when communicating with the ftp process.
+ (coding-system-used last-coding-system-used))
(unwind-protect
(progn
(let ((executing-kbd-macro t)
;; cleanup forms
(setq buffer-file-name filename)
(set-buffer-modified-p mod-p)))
+ ;; save value used by the real write-region
+ (setq coding-system-used last-coding-system-used)
(if binary
(ange-ftp-set-binary-mode host user))
(ange-ftp-set-buffer-mode)
(setq buffer-file-name filename)
(set-buffer-modified-p nil)))
+ ;; ensure `last-coding-system-used' has an appropriate value
+ (setq last-coding-system-used coding-system-used)
(ange-ftp-message "Wrote %s" abbr)
(ange-ftp-add-file-entry filename))
(ange-ftp-real-write-region start end filename append visit))))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
(binary (or (ange-ftp-binary-file filename)
- (and (not (eq system-type 'windows-nt))
- (eq (ange-ftp-host-type host user) 'unix))))
+ (eq (ange-ftp-host-type host user) 'unix)))
(abbr (ange-ftp-abbreviate-filename filename))
size)
(unwind-protect
(t-abbr (ange-ftp-abbreviate-filename newname filename))
(binary (or (ange-ftp-binary-file filename)
(ange-ftp-binary-file newname)
- (and (not (eq system-type 'windows-nt))
- (eq (ange-ftp-host-type f-host f-user) 'unix)
+ (and (eq (ange-ftp-host-type f-host f-user) 'unix)
(eq (ange-ftp-host-type t-host t-user) 'unix))))
temp1
temp2)
completions)))
(if (or (and (eq system-type 'windows-nt)
- (string-match "[^a-zA-Z]?[a-zA-Z]:[/\]" ange-ftp-this-dir))
+ (string-match "^[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
file tbl ange-ftp-this-dir
(function ange-ftp-file-entry-active-p)))))))
- (if (string-equal "/" ange-ftp-this-dir)
+ (if (or (and (eq system-type 'windows-nt)
+ (string-match "^[a-zA-Z]:[/\\]$" ange-ftp-this-dir))
+ (string-equal "/" ange-ftp-this-dir))
(try-completion
file
(nconc (ange-ftp-generate-root-prefixes)
(mapcar 'list
- (ange-ftp-real-file-name-all-completions file "/"))))
+ (ange-ftp-real-file-name-all-completions
+ file ange-ftp-this-dir))))
(ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
-;; Force a re-read of the directory DIR. If DIR is omitted then it defaults
-;; to the directory part of the contents of the current buffer.
-(defun ange-ftp-re-read-dir (&optional dir)
+;; The autoload cookie is to make sure the doc is always available.
+;;;###autoload (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
+;;;###autoload
+(defun ange-ftp-reread-dir (&optional dir)
+ "Reread remote directory DIR to update the directory cache.
+The implementation of remote ftp file names caches directory contents
+for speed. Therefore, when new remote files are created, Emacs
+may not know they exist. You can use this command to reread a specific
+directory, so that Emacs will know its current contents."
(interactive)
(if dir
(setq dir (expand-file-name dir))
(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,
+;;; This regexp recognizes absolute filenames with only one component,
;;; for the sake of hostname completion.
;;;###autoload
(or (assoc "^/[^/:]*\\'" file-name-handler-alist)
(cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
file-name-handler-alist)))
-;;; Absolute file names prefixed with a drive letter.
-;;;###autoload
+;;; This regexp recognizes absolute filenames with only one component
+;;; on Windows, for the sake of hostname completion.
+;;; NB. Do not mark this as autoload, because it is very common to
+;;; do completions in the root directory of drives on Windows.
(and (memq system-type '(ms-dos windows-nt))
(or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
(setq file-name-handler-alist
(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)
;; (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.