;; 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:
;;
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))
"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 grep-null-device)
+ (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))
- ;; 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 (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)))))
;; 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))
;; we need to reset `last-coding-system-used' to its
(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
(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
completions)))
(if (or (and (eq system-type 'windows-nt)
- (string-match "^[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))
(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)))
-;;; 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
"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))
HCoop / bpt / emacs.git / blobdiff