From: Geoff Voelker Date: Fri, 17 Apr 1998 05:22:37 +0000 (+0000) Subject: (ange-ftp-tmp-name-template) [windows-nt]: Look for X-Git-Tag: emacs-20.3~1459 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c4185b2b8db3b3a33c65855df1c510aec7c6b247;p=emacs.git (ange-ftp-tmp-name-template) [windows-nt]: Look for common temp directories. (ange-ftp-parse-netrc-group): Skip carriage returns. (ange-ftp-expand-file-name): Handle files with drive letters. (ange-ftp-write-region): Don't treat as unix. (ange-ftp-insert-file-contents): Determine file type by transfer mode. (ange-ftp-copy-file-internal): Don't treat as unix. (ange-ftp-file-name-all-completions): Handle Windows filenames. (file-name-handler-alist) [windows-nt]: Add patterns for name with drive letters. (ange-ftp-dired-call-process, ange-ftp-call-chmod): Use dired-chmod-program. (ange-ftp-disable-netrc-security-check) [windows-nt]: Disable by default. (ange-ftp-real-expand-file-name-actual): New function. --- diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el index c7e980e6f2c..85e60e8a5a9 100644 --- a/lisp/ange-ftp.el +++ b/lisp/ange-ftp.el @@ -700,7 +700,10 @@ These mean that the FTP process should (or already has) been killed." :group 'ange-ftp :type 'regexp) -(defcustom ange-ftp-tmp-name-template "/tmp/ange-ftp" +(defcustom ange-ftp-tmp-name-template + (if (memq system-type '(ms-dos windows-nt)) + (concat (or (getenv "TEMP") (getenv "TMP") "c:/temp") "/ange-ftp") + "/tmp/ange-ftp") "*Template used to create temporary files." :group 'ange-ftp :type 'directory) @@ -1307,11 +1310,11 @@ Optional DEFAULT is password to start with." (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) @@ -1376,7 +1379,7 @@ Optional DEFAULT is password to start with." (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))) @@ -3041,6 +3044,8 @@ logged in as user USER and cd'd to directory DIR." (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 @@ -3116,8 +3121,12 @@ system TYPE.") (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 @@ -3180,7 +3189,8 @@ system TYPE.") (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 @@ -3203,7 +3213,10 @@ system TYPE.") (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:" @@ -3462,7 +3475,8 @@ system TYPE.") (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) @@ -3750,7 +3764,9 @@ system TYPE.") 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)) @@ -4048,18 +4064,24 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;;; and colon). ;;; Don't allow the host name to end in a period--some systems use /.: ;;;###autoload -(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) - (setq file-name-handler-alist - (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) - file-name-handler-alist))) +(let ((pattern (if (memq system-type '(ms-dos windows-nt)) + "^[a-zA-Z]:/[^/:]*[^/:.]:" + "^/[^/:]*[^/:.]:"))) + (or (assoc pattern file-name-handler-alist) + (setq file-name-handler-alist + (cons (cons pattern 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))) +(let ((pattern (if (memq system-type '(ms-dos windows-nt)) + "^[a-zA-Z]:/[^/:]*\\'" + "^/[^/:]*\\'"))) + (or (assoc pattern file-name-handler-alist) + (setq file-name-handler-alist + (cons (cons pattern 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. @@ -4138,8 +4160,12 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (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) @@ -4260,7 +4286,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; 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)) @@ -4304,7 +4330,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (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) @@ -5631,6 +5657,26 @@ Other orders of $ and _ seem to all work just fine.") ;; (setq ange-ftp-dired-get-filename-alist ;; (cons '(cms . ange-ftp-dired-cms-get-filename) ;; ange-ftp-dired-get-filename-alist))) + +;; +(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) + (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) + ;;;; ------------------------------------------------------------ ;;;; Finally provide package.