;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2011 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^500 .*AUTH\\|^KERBEROS\\|"
- "^530 Please login with USER and PASS\\|" ; non kerberised vsFTPd
+ "^504 Unknown security mechanism\\|"
+ "^530 Please login with USER and PASS\\|" ; non kerberized vsFTPd
"^534 Kerberos Authentication not enabled\\|"
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT")
"Regular expression matching FTP messages that can be ignored."
:type '(choice (const :tag "Default" nil)
string))
-(defcustom ange-ftp-binary-file-name-regexp
- (concat "TAGS\\'\\|\\.\\(?:"
- (eval-when-compile
- (regexp-opt '("z" "Z" "lzh" "arc" "zip" "zoo" "tar" "dvi"
- "ps" "elc" "gif" "gz" "taz" "tgz")))
- "\\|EXE\\(;[0-9]+\\)?\\|[zZ]-part-..\\)\\'")
+(defcustom ange-ftp-binary-file-name-regexp ""
"If a file matches this regexp then it is transferred in binary mode."
:group 'ange-ftp
- :type 'regexp)
+ :type 'regexp
+ :version "24.1")
(defcustom ange-ftp-gateway-host nil
"Name of host to use as gateway machine when local FTP isn't possible."
;;; Temporary file location and deletion...
;;; ------------------------------------------------------------
-(defun ange-ftp-make-tmp-name (host)
+(defun ange-ftp-make-tmp-name (host &optional suffix)
"This routine will return the name of a new file."
(make-temp-file (if (ange-ftp-use-gateway-p host)
ange-ftp-gateway-tmp-name-template
- ange-ftp-tmp-name-template)))
+ ange-ftp-tmp-name-template)
+ nil suffix))
(defun ange-ftp-del-tmp-name (filename)
"Force to delete temporary file."
(and files (puthash (file-name-as-directory directory)
files ange-ftp-files-hashtable)))
+(defun ange-ftp-switches-ok (switches)
+ "Return SWITCHES (a string) if suitable for our use."
+ (and (stringp switches)
+ ;; We allow the A switch, which lists all files except "." and
+ ;; "..". This is OK because we manually insert these entries
+ ;; in the hash table.
+ (string-match
+ "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches)
+ (string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
+ (not (string-match
+ "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches))
+ switches))
+
(defun ange-ftp-get-files (directory &optional no-error)
"Given a DIRECTORY, return a hashtable of file entries.
This will give an error or return nil, depending on the value of
;; This is an efficiency hack. We try to
;; anticipate what sort of listing dired
;; might want, and cache just such a listing.
- (if (and (boundp 'dired-actual-switches)
- (stringp dired-actual-switches)
- ;; We allow the A switch, which lists
- ;; all files except "." and "..".
- ;; This is OK because we manually
- ;; insert these entries
- ;; in the hash table.
- (string-match
- "[aA]" dired-actual-switches)
- (string-match
- "l" dired-actual-switches)
- (not (string-match
- "R" dired-actual-switches)))
- dired-actual-switches
- (if (and (boundp 'dired-listing-switches)
- (stringp dired-listing-switches)
- (string-match
- "[aA]" dired-listing-switches)
- (string-match
- "l" dired-listing-switches)
- (not (string-match
- "R" dired-listing-switches)))
- dired-listing-switches
- "-al"))
+ (or (and (boundp 'dired-actual-switches)
+ (ange-ftp-switches-ok dired-actual-switches))
+ (and (boundp 'dired-listing-switches)
+ (ange-ftp-switches-ok
+ dired-listing-switches))
+ "-al")
t no-error)
(gethash directory ange-ftp-files-hashtable)))))
;; 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)
- (and (not (memq system-type
- '(ms-dos windows-nt)))
- (memq (ange-ftp-host-type host user)
- '(unix dumb-unix)))))
+ (binary (ange-ftp-binary-file filename))
(cmd (if append 'append 'put))
(abbr (ange-ftp-abbreviate-filename filename))
;; we need to reset `last-coding-system-used' to its
(user (nth 1 parsed))
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
- (binary (or (ange-ftp-binary-file filename)
- (memq (ange-ftp-host-type host user)
- '(unix dumb-unix))))
+ (binary (ange-ftp-binary-file filename))
+ (buffer-file-type buffer-file-type)
(abbr (ange-ftp-abbreviate-filename filename))
(coding-system-used last-coding-system-used)
size)
(t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
(t-abbr (ange-ftp-abbreviate-filename newname filename))
(binary (or (ange-ftp-binary-file filename)
- (ange-ftp-binary-file newname)
- (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)))))
+ (ange-ftp-binary-file newname)))
temp1
temp2)
(concat bestmatch "/")
bestmatch)))))
-;; Put these lines uncommmented in your .emacs if you want C-r to refresh
+;; Put these lines uncommented in your .emacs if you want C-r to refresh
;; ange-ftp's cache whilst doing filename completion.
;;
;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
(ange-ftp-get-files dir t))))
\f
(defun ange-ftp-make-directory (dir &optional parents)
- (interactive (list (expand-file-name (read-file-name "Make directory: "))))
+ (interactive (list (expand-file-name (read-directory-name "Make directory: "))))
(if parents
(let ((parent (file-name-directory (directory-file-name dir))))
(or (file-exists-p parent)
(let* ((fn1 (expand-file-name file))
(pa1 (ange-ftp-ftp-name fn1)))
(if pa1
- (let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
+ (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)
+ (file-name-extension file t))))
(ange-ftp-copy-file-internal fn1 tmp1 t nil
(format "Getting %s" fn1))
tmp1))))
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
-(defun ange-ftp-run-real-handler (operation args)
- (let ((inhibit-file-name-handlers
- (cons 'ange-ftp-hook-function
- (cons 'ange-ftp-completion-hook-function
- (and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers))))
- (inhibit-file-name-operation operation))
- (apply operation args)))
+;(defun ange-ftp-run-real-handler (operation args)
+; (let ((inhibit-file-name-handlers
+; (cons 'ange-ftp-hook-function
+; (cons 'ange-ftp-completion-hook-function
+; (and (eq inhibit-file-name-operation operation)
+; inhibit-file-name-handlers))))
+; (inhibit-file-name-operation operation))
+; (apply operation args)))
+
+(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler)
(defun ange-ftp-real-file-name-directory (&rest args)
(ange-ftp-run-real-handler 'file-name-directory args))
;; We used to follow symlinks on `file' here. Apparently it was done
;; because some FTP servers react to "ls foo" by listing the symlink foo
;; rather than the directory it points to. Now that ange-ftp-ls uses
- ;; "cd foo; ls" instead, this is not necesssary any more.
+ ;; "cd foo; ls" instead, this is not necessary any more.
(let ((beg (point))
(end (point-marker)))
(set-marker-insertion-type end t)
;; ;; This is the Unix dl version.
;; (let ((opoint (point))
;; case-fold-search hidden)
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion
;; (search-forward "\r" eol t))))
dir (and dir "/")
file))
(error "name %s didn't match" name))
- (let (drive dir file tmp)
+ (let (drive dir file tmp quote)
+ (if (string-match "\\`\".+\"\\'" name)
+ (setq name (substring name 1 -1)
+ quote "\"")
+ (setq quote ""))
(if (string-match "\\`/[^:]+:/" name)
(setq drive (substring name 1
(1- (match-end 0)))
(if tmp
(setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t)))
(setq file (file-name-nondirectory name))
- (concat drive
+ (concat quote drive
(and dir (concat "[" (if drive nil ".") dir "]"))
- file)))))
+ file quote)))))
;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
;; ;; This is the VMS version.
;; (let (opoint hidden case-fold-search)
;; (setq opoint (point))
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion (search-forward "\r" eol t))))
;; (if hidden
;; base-versions
;; (file-name-directory fn)))
;; (versions (mapcar
-;; '(lambda (arg)
+;; (lambda (arg)
;; (if (and (string-match
;; "[0-9]+$" arg bv-length)
;; (= (match-beginning 0) bv-length))
;; ;; This is the MTS version.
;; (let (opoint hidden case-fold-search)
;; (setq opoint (point)
-;; eol (save-excursion (end-of-line) (point))
+;; eol (line-end-position)
;; hidden (and selective-display
;; (save-excursion (search-forward "\r" eol t))))
;; (if hidden
;; ;; This is the CMS version.
;; (let ((opoint (point))
;; case-fold-search hidden)
-;; (or eol (setq eol (save-excursion (end-of-line) (point))))
+;; (or eol (setq eol (line-end-position)))
;; (setq hidden (and selective-display
;; (save-excursion
;; (search-forward "\r" eol t))))
(provide 'ange-ftp)
-;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
;;; ange-ftp.el ends here
HCoop / bpt / emacs.git / blobdiff