;;; 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
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;;; Code:
(require 'comint)
-;; Silence compiler:
-(eval-when-compile
- (require 'dired)
- (defvar comint-last-output-start nil)
- (defvar comint-last-input-start nil)
- (defvar comint-last-input-end nil))
;;;; ------------------------------------------------------------
;;;; User customization variables.
"Accessing remote files and directories using FTP
made as simple and transparent as possible."
:group 'files
+ :group 'comm
:prefix "ange-ftp-")
(defcustom ange-ftp-name-format
"^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
- "^500 .*AUTH \\(KERBEROS\\|GSSAPI\\)\\|^KERBEROS\\|"
+ "^500 .*AUTH\\|^KERBEROS\\|"
+ "^504 Unknown security mechanism\\|"
"^530 Please login with USER and PASS\\|" ; non kerberised vsFTPd
"^534 Kerberos Authentication not enabled\\|"
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT")
ange-ftp-gateway-tmp-name-template
ange-ftp-tmp-name-template)))
-(defalias 'ange-ftp-del-tmp-name 'delete-file)
+(defun ange-ftp-del-tmp-name (filename)
+ "Force to delete temporary file."
+ (delete-file filename))
+
\f
;;;; ------------------------------------------------------------
;;;; Interactive gateway program support.
(defmacro ange-ftp-parse-filename ()
;;Extract the filename from the current line of a dired-like listing.
- `(let ((eol (progn (end-of-line) (point))))
- (beginning-of-line)
- (if (re-search-forward directory-listing-before-filename-regexp eol t)
- (buffer-substring (point) eol))))
+ `(save-match-data
+ (let ((eol (progn (end-of-line) (point))))
+ (beginning-of-line)
+ (if (re-search-forward directory-listing-before-filename-regexp eol t)
+ (buffer-substring (point) eol)))))
;; This deals with the F switch. Should also do something about
;; unquoting names obtained with the SysV b switch and the GNU Q
(nreverse files)))
(apply 'ange-ftp-real-directory-files directory full match v19-args)))
+(defun ange-ftp-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ (setq directory (expand-file-name directory))
+ (if (ange-ftp-ftp-name directory)
+ (mapcar
+ (lambda (file)
+ (cons file (file-attributes (expand-file-name file directory))))
+ (ange-ftp-directory-files directory full match nosort))
+ (ange-ftp-real-directory-files-and-attributes
+ directory full match nosort id-format)))
+
(defun ange-ftp-file-attributes (file &optional id-format)
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(file-exists-p file)
(ange-ftp-real-file-executable-p file))))
-(defun ange-ftp-delete-file (file)
- (interactive "fDelete file: ")
+(defun ange-ftp-delete-file (file &optional trash)
+ (interactive (list (read-file-name "Delete file: " nil default-directory)
+ (null current-prefix-arg)))
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
(format "FTP Error: \"%s\"" (cdr result))
file)))
(ange-ftp-delete-file-entry file))
- (ange-ftp-real-delete-file file))))
+ (ange-ftp-real-delete-file file trash))))
(defun ange-ftp-file-modtime (file)
"Return the modification time of remote file FILE.
(ange-ftp-call-cont cont result line)))
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
- keep-date preserve-uid-gid)
+ keep-date preserve-uid-gid
+ preserve-selinux-context)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
(put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
(put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
(put 'directory-files 'ange-ftp 'ange-ftp-directory-files)
+(put 'directory-files-and-attributes 'ange-ftp
+ 'ange-ftp-directory-files-and-attributes)
(put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
(put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
(put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
(ange-ftp-run-real-handler 'insert-file-contents args))
(defun ange-ftp-real-directory-files (&rest args)
(ange-ftp-run-real-handler 'directory-files args))
+(defun ange-ftp-real-directory-files-and-attributes (&rest args)
+ (ange-ftp-run-real-handler 'directory-files-and-attributes args))
(defun ange-ftp-real-file-directory-p (&rest args)
(ange-ftp-run-real-handler 'file-directory-p args))
(defun ange-ftp-real-file-writable-p (&rest args)
;; 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.
- (insert
- (cond
- (wildcard
- (let ((default-directory (file-name-directory file)))
- (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
- (full
- (ange-ftp-ls file switches 'parse))
- (t
- ;; If `full' is nil we're going to do `ls' for a single file.
- ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
- ;; then do an ls of current dir, which obviously won't work if we
- ;; want to ls a file. So instead, we get a full listing of the
- ;; parent directory and extract the line corresponding to `file'.
- (when (string-match "-?d\\'" switches)
- ;; Remove "d" which dired added to `switches'.
- (setq switches (substring switches 0 (match-beginning 0))))
- (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
- switches nil))
- (filename (file-name-nondirectory (directory-file-name file)))
- (case-fold-search nil))
- ;; FIXME: This presumes a particular output format, which is
- ;; basically Unix.
- (if (string-match (concat "^.+[^ ] " (regexp-quote filename)
- "\\( -> .*\\)?[@/*=]?\n") dirlist)
- (match-string 0 dirlist)
- "")))))))
+ (let ((beg (point))
+ (end (point-marker)))
+ (set-marker-insertion-type end t)
+ (insert
+ (cond
+ (wildcard
+ (let ((default-directory (file-name-directory file)))
+ (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
+ (full
+ (ange-ftp-ls file switches 'parse))
+ (t
+ ;; If `full' is nil we're going to do `ls' for a single file.
+ ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
+ ;; then do an ls of current dir, which obviously won't work if we
+ ;; want to ls a file. So instead, we get a full listing of the
+ ;; parent directory and extract the line corresponding to `file'.
+ (when (string-match "-?d\\'" switches)
+ ;; Remove "d" which dired added to `switches'.
+ (setq switches (substring switches 0 (match-beginning 0))))
+ (setq file (directory-file-name file))
+ (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
+ switches 'parse))
+ (filename (file-name-nondirectory file))
+ (case-fold-search nil))
+ ;; FIXME: This presumes a particular output format, which is
+ ;; basically Unix.
+ (if (string-match (concat "^.+[^ ] " (regexp-quote filename)
+ "\\( -> .*\\)?[@/*=]?\n") dirlist)
+ (match-string 0 dirlist)
+ "")))))
+
+ ;; Insert " " for dired's alignment sanity.
+ (goto-char beg)
+ (while (re-search-forward "^\\(\\S-\\)" end 'move)
+ (replace-match " \\1"))
+
+ ;; The inserted file could be from somewhere else.
+ (when (and (not wildcard) (not full)
+ (search-backward
+ (if (zerop (length (file-name-nondirectory
+ (expand-file-name file))))
+ "."
+ (file-name-nondirectory file))
+ nil 'noerror))
+ (replace-match (file-relative-name (expand-file-name file)) t)
+ (goto-char end))
+
+ (set-marker end nil))))
(defun ange-ftp-dired-uncache (dir)
(if (ange-ftp-ftp-name (expand-file-name dir))
;; Can't use ange-ftp-dired-host-type here because the current
;; buffer is *dired-check-process output*
(condition-case oops
- (cond ((equal dired-chmod-program program)
+ (cond ((equal (or (bound-and-true-p dired-chmod-program) "chmod")
+ program)
(ange-ftp-call-chmod arguments))
;; ((equal "chgrp" program))
;; ((equal dired-chown-program program))