;; ange-ftp-dired-host-type for local buffers.
;;
;; t = a remote host of unknown type. Think t as in true, it's remote.
-;; Currently, 'unix is used as the default remote host type.
+;; Currently, `unix' is used as the default remote host type.
;; Maybe we should use t.
;;
-;; 'type = a remote host of TYPE type.
+;; TYPE = a remote host of TYPE type.
;;
-;; 'type:list = a remote host of TYPE type, using a specialized ftp listing
-;; program called list. This is currently only used for Unix
-;; dl (descriptive listings), when ange-ftp-dired-host-type
-;; is set to 'unix:dl.
+;; TYPE:LIST = a remote host of TYPE type, using a specialized ftp listing
+;; program called list. This is currently only used for Unix
+;; dl (descriptive listings), when ange-ftp-dired-host-type
+;; is set to `unix:dl'.
;; Bug report codes:
;;
:group 'ange-ftp
:type 'regexp)
-(defcustom ange-ftp-tmp-name-template "/tmp/ange-ftp"
+(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)
: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."
;;;; Password support.
;;;; ------------------------------------------------------------
-(defun ange-ftp-read-passwd (prompt &optional default)
- "Read a password, echoing `.' for each character typed.
-End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
-Optional DEFAULT is password to start with."
- (let ((pass nil)
- (c 0)
- (echo-keystrokes 0)
- (cursor-in-echo-area t))
- (while (progn (message "%s%s"
- prompt
- (make-string (length pass) ?.))
- (setq c (read-char))
- (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
- (if (= c ?\C-u)
- (setq pass "")
- (if (and (/= c ?\b) (/= c ?\177))
- (setq pass (concat pass (char-to-string c)))
- (if (> (length pass) 0)
- (setq pass (substring pass 0 -1))))))
- (message "")
- (ange-ftp-repaint-minibuffer)
- (or pass default "")))
-
(defmacro ange-ftp-generate-passwd-key (host user)
(` (concat (downcase (, host)) "/" (, user))))
"For a given HOST and USER, set or change the associated PASSWORD."
(interactive (list (read-string "Host: ")
(read-string "User: ")
- (ange-ftp-read-passwd "Password: ")))
+ (read-passwd "Password: ")))
(ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
passwd
ange-ftp-passwd-hashtable))
;; found another machine with the same user.
;; Try that account.
- (ange-ftp-read-passwd
+ (read-passwd
(format "passwd for %s@%s (default same as %s@%s): "
user host user other)
+ nil
(ange-ftp-lookup-passwd other user))
;; I give up. Ask the user for the password.
- (ange-ftp-read-passwd
+ (read-passwd
(format "Password for %s@%s: " user host)))))
(ange-ftp-set-passwd host user passwd)
passwd))))
"For a given HOST and USER, set or change the associated ACCOUNT password."
(interactive (list (read-string "Host: ")
(read-string "User: ")
- (ange-ftp-read-passwd "Account password: ")))
+ (read-passwd "Account password: ")))
(ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
account
ange-ftp-account-hashtable))
(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."
(process-kill-without-query proc)
(set-process-sentinel proc (function ange-ftp-process-sentinel))
(set-process-filter proc (function ange-ftp-process-filter))
+ ;; 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))
"Return a symbol which represents the type of the HOST given.
If the optional argument USER is given, attempts to guess the
host-type by logging in as USER."
- (if (eq host ange-ftp-host-cache)
- ange-ftp-host-type-cache
- ;; Trigger an ftp connection, in case we need to guess at the host type.
- (if (and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
- ange-ftp-host-type-cache
- (setq ange-ftp-host-cache host
- ange-ftp-host-type-cache
- (cond ((ange-ftp-dumb-unix-host host)
- 'dumb-unix)
-;; ((and (fboundp 'ange-ftp-vos-host)
-;; (ange-ftp-vos-host host))
-;; 'vos)
- ((and (fboundp 'ange-ftp-vms-host)
- (ange-ftp-vms-host host))
- 'vms)
- ((and (fboundp 'ange-ftp-mts-host)
- (ange-ftp-mts-host host))
- 'mts)
- ((and (fboundp 'ange-ftp-cms-host)
- (ange-ftp-cms-host host))
- 'cms)
- (t
- 'unix))))))
+ (cond ((null host) 'unix)
+ ;; Return `unix' if HOST is nil, since that's the most vanilla
+ ;; possible return value.
+ ((eq host ange-ftp-host-cache)
+ ange-ftp-host-type-cache)
+ ;; Trigger an ftp connection, in case we need to guess at the host type.
+ ((and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
+ ange-ftp-host-type-cache)
+ (t
+ (setq ange-ftp-host-cache host
+ ange-ftp-host-type-cache
+ (cond ((ange-ftp-dumb-unix-host host)
+ 'dumb-unix)
+ ;; ((and (fboundp 'ange-ftp-vos-host)
+ ;; (ange-ftp-vos-host host))
+ ;; 'vos)
+ ((and (fboundp 'ange-ftp-vms-host)
+ (ange-ftp-vms-host host))
+ 'vms)
+ ((and (fboundp 'ange-ftp-mts-host)
+ (ange-ftp-mts-host host))
+ 'mts)
+ ((and (fboundp 'ange-ftp-cms-host)
+ (ange-ftp-cms-host host))
+ 'cms)
+ (t
+ 'unix))))))
;; It would be nice to abstract the functions ange-ftp-TYPE-host and
;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
(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
(host-type (ange-ftp-host-type
(car parsed))))
(or
-;;; This variable seems not to exist in Emacs 19 -- rms.
-;;; ;; Deal with dired
-;;; (and (boundp 'dired-local-variables-file)
-;;; (stringp dired-local-variables-file)
-;;; (string-equal dired-local-variables-file efile))
+ ;; Deal with dired
+ (and (boundp 'dired-local-variables-file) ; in the dired-x package
+ (stringp dired-local-variables-file)
+ (string-equal dired-local-variables-file efile))
;; No dots in dir names in vms.
(and (eq host-type 'vms)
(string-match "\\." efile))
"\\|"
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 name starts with //, preserve that, for apollo system.
(if (not (string-match "^//" name))
(progn
- (setq name (ange-ftp-real-expand-file-name name))
-
+ (if (not (eq system-type 'windows-nt))
+ (setq name (ange-ftp-real-expand-file-name name))
+ ;; Windows UNC default dirs do not make sense for ftp.
+ (if (string-match "^//" default-directory)
+ (setq name (ange-ftp-real-expand-file-name name "c:/"))
+ (setq name (ange-ftp-real-expand-file-name name)))
+ ;; Strip off possible drive specifier.
+ (if (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)
+ (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.
(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)))
+ (memq (ange-ftp-host-type host user)
+ '(unix dumb-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)
- (eq (ange-ftp-host-type host user) 'unix)))
+ (memq (ange-ftp-host-type host user)
+ '(unix dumb-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:"
(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)
- (eq (ange-ftp-host-type t-host t-user) 'unix))))
+ (and (memq (ange-ftp-host-type f-host f-user)
+ '(unix dumb-unix))
+ (memq (ange-ftp-host-type t-host t-user)
+ '(unix dumb-unix)))))
temp1
temp2)
t-parsed t-host t-user t-name t-abbr
nil nil cont nowait))))))
+(defvar ange-ftp-waiting-flag nil)
+
;; next part of copying routine.
(defun ange-ftp-cf1 (result line
filename newname binary msg
file))))
completions)))
- (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))
(nconc (all-completions file (ange-ftp-generate-root-prefixes))
(ange-ftp-real-file-name-all-completions file
ange-ftp-this-dir))
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))
(format "Getting %s" fn1))
tmp1))))
-(defvar ange-ftp-waiting-flag nil)
-
(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
(if (ange-ftp-ftp-name file)
(let ((tryfiles (if nosuffix
(cons '("^/[^/:]*[^/:.]:" . 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)))
+;;; 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
+ (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.
"Alist of mapping host type into function to remove file version numbers.")
(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
- (setq file (ange-ftp-abbreviate-filename file))
- (let ((parsed (ange-ftp-ftp-name file))
- host-type func)
+ (let* ((short (ange-ftp-abbreviate-filename file))
+ (parsed (ange-ftp-ftp-name short))
+ host-type func)
(if parsed
(setq host-type (ange-ftp-host-type (car parsed))
func (cdr (assq (ange-ftp-host-type (car parsed))
;; 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))
(or (car result)
(call-process
ange-ftp-remote-shell
- nil t nil host "chmod" mode name)))))))
+ nil t nil host dired-chmod-program mode name)))))))
rest))
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
0)
HCoop / bpt / emacs.git / blobdiff