;;; tramp-fish.el --- Tramp access functions for FISH protocol
-;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, see
-;; <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; parameter of `write-region'. Transfer of binary data fails due to
;; Emacs' process input/output handling.
-
;;; Code:
+(eval-when-compile
+ ;; Pacify byte-compiler.
+ (require 'cl))
+
(require 'tramp)
(require 'tramp-cache)
(require 'tramp-compat)
(directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes)
;; `dired-call-process' performed by default handler
;; `dired-compress-file' performed by default handler
- ;; `dired-uncache' performed by default handler
+ (dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-fish-handle-expand-file-name)
;; `file-accessible-directory-p' performed by default handler
(file-attributes . tramp-fish-handle-file-attributes)
(file-executable-p . tramp-fish-handle-file-executable-p)
(file-exists-p . tramp-fish-handle-file-exists-p)
(file-local-copy . tramp-fish-handle-file-local-copy)
- (file-remote-p . tramp-handle-file-remote-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-fish-handle-file-name-all-completions)
- ;; `file-name-as-directory' performed by default handler
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-completion . tramp-handle-file-name-completion)
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-fish-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ ;; `file-selinux-context' performed by default handler.
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler
(file-writable-p . tramp-fish-handle-file-writable-p)
(make-symbolic-link . tramp-fish-handle-make-symbolic-link)
(rename-file . tramp-fish-handle-rename-file)
(set-file-modes . tramp-fish-handle-set-file-modes)
+ ;; `set-file-selinux-context' performed by default handler.
(set-file-times . tramp-fish-handle-set-file-times)
(set-visited-file-modtime . ignore)
(shell-command . tramp-handle-shell-command)
v1 'file-error "Error with add-name-to-file %s" newname)))))
(defun tramp-fish-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files."
(tramp-fish-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
-(defun tramp-fish-handle-delete-directory (directory)
+(defun tramp-fish-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
(when (file-exists-p directory)
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (tramp-compat-delete-directory file recursive)
+ (tramp-compat-delete-file file)))
+ ;; We do not want to delete "." and "..".
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(with-parsed-tramp-file-name
- (directory-file-name (expand-file-name directory)) nil
- (tramp-flush-directory-property v localname)
- (tramp-fish-send-command-and-check v (format "#RMD %s" localname)))))
+ (directory-file-name (expand-file-name directory)) nil
+ (tramp-flush-directory-property v localname)
+ (tramp-fish-send-command-and-check v (format "#RMD %s" localname)))))
-(defun tramp-fish-handle-delete-file (filename)
+(defun tramp-fish-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(when (file-exists-p filename)
(with-parsed-tramp-file-name (expand-file-name filename) nil
"Like `directory-files-and-attributes' for Tramp files."
(mapcar
(lambda (x)
- ;; We cannot call `file-attributes' for backward compatibility reasons.
- ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
- (cons x (tramp-fish-handle-file-attributes
- (if full x (expand-file-name x directory)) id-format)))
+ (cons x
+ (tramp-compat-file-attributes
+ (if full x (expand-file-name x directory))
+ id-format)))
(directory-files directory full match nosort)))
(defun tramp-fish-handle-expand-file-name (name &optional dir)
(tramp-run-real-handler 'expand-file-name (list name nil)))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
- (unless (file-name-absolute-p localname)
+ (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
(setq localname (concat "~/" localname)))
;; Tilde expansion if necessary.
(when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
;; would otherwise use backslash. `default-directory' is
;; bound, because on Windows there would be problems with UNC
;; shares or Cygwin mounts.
- (tramp-let-maybe directory-sep-char ?/
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (tramp-make-tramp-file-name
- method user host
- (tramp-drop-volume-letter
- (tramp-run-real-handler 'expand-file-name
- (list localname)))))))))
+ (let ((directory-sep-char ?/)
+ (default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ method user host
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ 'expand-file-name (list localname))))))))
(defun tramp-fish-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
- (when (tramp-fish-retrieve-data v)
- ;; Save file
- (with-current-buffer (tramp-get-buffer v)
- (write-region (point-min) (point-max) tmpfile))
- (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
- tmpfile))))
+ (with-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ (when (tramp-fish-retrieve-data v)
+ ;; Save file
+ (with-current-buffer (tramp-get-buffer v)
+ (write-region (point-min) (point-max) tmpfile))
+ tmpfile)))))
;; This function should return "foo/" for directories and "bar" for
;; files.
(let ((point (point))
size)
- (tramp-message v 4 "Fetching file %s..." filename)
- (when (tramp-fish-retrieve-data v)
- ;; Insert file
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (let ((beg (or beg (point-min)))
- (end (min (or end (point-max)) (point-max))))
- (setq size (- end beg))
- (buffer-substring beg end))))
- (goto-char point))
- (tramp-message v 4 "Fetching file %s...done" filename)
+ (with-progress-reporter v 3 (format "Fetching file %s" filename)
+ (when (tramp-fish-retrieve-data v)
+ ;; Insert file
+ (insert
+ (with-current-buffer (tramp-get-buffer v)
+ (let ((beg (or beg (point-min)))
+ (end (min (or end (point-max)) (point-max))))
+ (setq size (- end beg))
+ (buffer-substring beg end))))
+ (goto-char point)))
(list (expand-file-name filename) size)))))
localname)))))
(tramp-error
v 'file-already-exists "File %s already exists" localname)
- (delete-file linkname)))
+ (tramp-compat-delete-file linkname)))
;; If FILENAME is a Tramp name, use just the localname component.
(when (tramp-tramp-file-p filename)
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
;; Cleanup.
- (when tmpinput (delete-file tmpinput))
- (when tmpoutput (delete-file tmpoutput))
+ (when tmpinput (tramp-compat-delete-file tmpinput))
+ (when tmpoutput (tramp-compat-delete-file tmpoutput))
;; Return exit status.
ret)))
(when (and keep-date (functionp 'set-file-times))
(set-file-times newname (nth 5 (file-attributes filename))))
;; Set the mode.
- (set-file-modes newname (file-modes filename)))
+ (set-file-modes newname (tramp-default-file-modes filename)))
(defun tramp-fish-get-file-entries (vec localname list)
"Read entries returned by FISH server.
;; last line
((looking-at "^$")
(return)))
- ;; delete line
+ ;; Delete line.
(forward-line)
(delete-region (point-min) (point))))
- ;; delete trailing empty line
+ ;; Delete trailing empty line.
(forward-line)
(delete-region (point-min) (point))
- ;; Return entry in file-attributes format
+ ;; Return entry in `file-attributes' format.
(list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil)))
(defun tramp-fish-retrieve-data (vec)
(when (and p (processp p))
(delete-process p))
(setenv "TERM" tramp-terminal-type)
- (setenv "PS1" "$ ")
- (tramp-message
- vec 3 "Opening connection for %s@%s using %s..."
- tramp-current-user tramp-current-host tramp-current-method)
-
- (let* ((process-connection-type tramp-process-connection-type)
- (inhibit-eol-conversion nil)
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- ;; This must be done in order to avoid our file name handler.
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec))
- (tramp-get-connection-buffer vec)
- "ssh" "-l"
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)))))
- (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " "))
-
- ;; Check whether process is alive.
- (set-process-sentinel p 'tramp-flush-connection-property)
- (tramp-set-process-query-on-exit-flag p nil)
-
- (tramp-process-actions p vec tramp-actions-before-shell 60)
- (tramp-fish-send-command vec tramp-fish-start-fish-server-command)
- (tramp-message
- vec 3
- "Found remote shell prompt on `%s'" (tramp-file-name-host vec))))))
+ (setenv "PS1" tramp-initial-end-of-output)
+ (with-progress-reporter
+ vec 3
+ (format "Opening connection for %s@%s using %s"
+ tramp-current-user tramp-current-host tramp-current-method)
+
+ (let* ((process-connection-type tramp-process-connection-type)
+ (inhibit-eol-conversion nil)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ ;; This must be done in order to avoid our file name handler.
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (start-process
+ (or (tramp-get-connection-property vec "process-name" nil)
+ (tramp-buffer-name vec))
+ (tramp-get-connection-buffer vec)
+ "ssh" "-l"
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)))))
+ (tramp-message
+ vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+
+ ;; Check whether process is alive.
+ (tramp-set-process-query-on-exit-flag p nil)
+
+ (tramp-process-actions p vec tramp-actions-before-shell 60)
+ (tramp-fish-send-command vec tramp-fish-start-fish-server-command)
+ (tramp-message
+ vec 3
+ "Found remote shell prompt on `%s'" (tramp-file-name-host vec)))))))
(defun tramp-fish-send-command (vec command)
"Send the COMMAND to connection VEC."
HCoop / bpt / emacs.git / blobdiff