X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/94cc397c541f50af6b049af6c42806daa2be2709..f1a5d776c4985b3ff1a2c6c17dd71dedf5d726e8:/lisp/net/tramp-fish.el diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el index f6f455b182..db5c8ad0b4 100644 --- a/lisp/net/tramp-fish.el +++ b/lisp/net/tramp-fish.el @@ -1,16 +1,16 @@ ;;; 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 ;; 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 @@ -18,8 +18,7 @@ ;; 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 -;; . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -150,9 +149,12 @@ ;; 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) @@ -210,7 +212,7 @@ Used instead of analyzing error codes of commands.") (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) @@ -218,10 +220,9 @@ Used instead of analyzing error codes of commands.") (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) @@ -230,6 +231,8 @@ Used instead of analyzing error codes of commands.") (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) @@ -244,6 +247,7 @@ Used instead of analyzing error codes of commands.") (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) @@ -308,20 +312,30 @@ pass to the OPERATION." 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 @@ -333,10 +347,10 @@ pass to the OPERATION." "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) @@ -352,7 +366,7 @@ pass to the OPERATION." (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) @@ -380,13 +394,13 @@ pass to the OPERATION." ;; 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." @@ -476,13 +490,13 @@ pass to the OPERATION." 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. @@ -580,17 +594,16 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (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))))) @@ -647,7 +660,7 @@ target of the symlink differ." 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) @@ -826,8 +839,8 @@ target of the symlink differ." ;; 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))) @@ -918,7 +931,7 @@ PRESERVE-UID-GID is completely ignored." (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. @@ -1022,15 +1035,15 @@ SIZE MODE WEIRD)." ;; 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) @@ -1103,36 +1116,37 @@ connection if a previous connection has died for some reason." (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."