-;;; -*- coding: iso-8859-1; -*-
;;; tramp-fish.el --- Tramp access functions for FISH protocol
-;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009 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 of the License, or
+;; 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,
;; 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:
(require 'tramp)
(require 'tramp-cache)
-
-;; Pacify byte-compiler
-(eval-when-compile
- (require 'cl)
- (require 'custom))
-
-;; Avoid byte-compiler warnings if the byte-compiler supports this.
-;; Currently, XEmacs supports this.
-(eval-when-compile
- (when (featurep 'xemacs)
- (byte-compiler-options (warnings (- unused-vars)))))
-
-;; `directory-sep-char' is an obsolete variable in Emacs. But it is
-;; used in XEmacs, so we set it here and there. The following is needed
-;; to pacify Emacs byte-compiler.
-(eval-when-compile
- (unless (boundp 'byte-compile-not-obsolete-var)
- (defvar byte-compile-not-obsolete-var nil))
- (setq byte-compile-not-obsolete-var 'directory-sep-char))
+(require 'tramp-compat)
;; Define FISH method ...
(defcustom tramp-fish-method "fish"
(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-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)
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)
+ (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Like `copy-file' for Tramp files."
(tramp-fish-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date))
+ '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)
- (with-parsed-tramp-file-name
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (tramp-compat-delete-directory file recursive)
+ (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)))))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a tramp file, run the real handler
- (if (or (tramp-completion-mode) (not (tramp-tramp-file-p name)))
+ ;; If NAME is not a Tramp file, run the real handler,
+ (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
(tramp-drop-volume-letter
(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)
(tramp-fish-send-command-and-check v "#PWD")
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-min))
- (buffer-substring (point) (tramp-line-end-position)))))
+ (buffer-substring (point) (tramp-compat-line-end-position)))))
(setq localname (concat uname fname))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
;; 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-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."
(tramp-error
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
- (let ((tmpfil (tramp-make-temp-file filename)))
- (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfil)
+ (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) tmpfil))
- (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfil)
- tmpfil))))
+ (write-region (point-min) (point-max) tmpfile))
+ (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
+ tmpfile))))
;; This function should return "foo/" for directories and "bar" for
;; files.
(if (zerop (process-file "which" nil t nil command))
(progn
(goto-char (point-min))
- (buffer-substring (point-min) (tramp-line-end-position))))))
+ (buffer-substring (point-min) (tramp-compat-line-end-position))))))
(defun tramp-fish-handle-process-file
(program &optional infile destination display &rest args)
(error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil
- (let ((temp-name-prefix (tramp-make-tramp-temp-file v))
- command input output stderr outbuf tmpfil ret)
+ (let (command input tmpinput output tmpoutput stderr tmpstderr
+ outbuf tmpfile ret)
;; Compute command.
(setq command (mapconcat 'tramp-shell-quote-argument
(cons program args) " "))
;; INFILE is on the same remote host.
(setq input (with-parsed-tramp-file-name infile nil localname))
;; INFILE must be copied to remote host.
- (setq input (concat temp-name-prefix ".in"))
- (copy-file
- infile
- (tramp-make-tramp-file-name method user host input)
- t)))
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
;; Determine output.
- (setq output (concat temp-name-prefix ".out"))
+ (setq output (tramp-make-tramp-temp-file v)
+ tmpoutput (tramp-make-tramp-file-name method user host output))
(cond
;; Just a buffer
((bufferp destination)
(cadr destination) nil localname))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
- (setq stderr (concat temp-name-prefix ".err"))))
+ (setq stderr (tramp-make-tramp-temp-file v)
+ tmpstderr (tramp-make-tramp-file-name
+ method user host stderr))))
;; stderr to be discarded
((null (cadr destination))
(setq stderr "/dev/null"))))
(setq outbuf (current-buffer))))
(when stderr (setq command (format "%s 2>%s" command stderr)))
- ;; If we have a temporary file, it must be removed after operation.
- (when (and input (string-match temp-name-prefix input))
- (setq command (format "%s; rm %s" command input)))
;; Goto working directory.
(unless
(tramp-fish-send-command-and-check
v (format
"#EXEC %s %s"
(tramp-shell-quote-argument command) output))
- (error))
+ (error nil))
;; Check return code.
- (setq tmpfil (file-local-copy
- (tramp-make-tramp-file-name method user host output)))
+ (setq tmpfile
+ (file-local-copy
+ (tramp-make-tramp-file-name method user host output)))
(with-temp-buffer
- (insert-file-contents tmpfil)
+ (insert-file-contents tmpfile)
(goto-char (point-max))
(forward-line -1)
(looking-at "^###RESULT: \\([0-9]+\\)")
(setq ret (string-to-number (match-string 1)))
(delete-region (point) (point-max))
- (write-region (point-min) (point-max) tmpfil))
+ (write-region (point-min) (point-max) tmpfile))
;; We should show the output anyway.
(when outbuf
- (with-current-buffer outbuf (insert-file-contents tmpfil))
- (when display (display-buffer outbuf)))
- ;; Remove output file.
- (delete-file (tramp-make-tramp-file-name method user host output)))
+ (with-current-buffer outbuf (insert-file-contents tmpfile))
+ (when display (display-buffer outbuf))))
;; When the user did interrupt, we should do it also.
(error (setq ret 1)))
- (unless ret
- ;; Provide error file.
- (when (and stderr (string-match temp-name-prefix stderr))
- (rename-file (tramp-make-tramp-file-name method user host stderr)
- (cadr destination) t)))
+
+ ;; Provide error file.
+ (when tmpstderr (rename-file tmpstderr (cadr destination) t))
+ ;; Cleanup.
+ (when tmpinput (delete-file tmpinput))
+ (when tmpoutput (delete-file tmpoutput))
;; Return exit status.
ret)))
;; Internal file name functions
(defun tramp-fish-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date)
+ (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Copy or rename a remote file.
OP must be `copy' or `rename' and indicates the operation to
perform. FILENAME specifies the file to copy or rename, NEWNAME
;; directly.
((tramp-equal-remote filename newname)
(tramp-fish-do-copy-or-rename-file-directly
- op filename newname keep-date))
+ op filename newname keep-date preserve-uid-gid))
;; No shortcut was possible. So we copy the
;; file first. If the operation was `rename', we go
;; back and delete the original file (if the copy was
(tramp-flush-file-property v (file-name-directory localname)))))))
(defun tramp-fish-do-copy-or-rename-file-directly
- (op filename newname keep-date)
+ (op filename newname keep-date preserve-uid-gid)
"Invokes `COPY' or `RENAME' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',
respectively. VEC specifies the connection. LOCALNAME1 and
LOCALNAME2 specify the two arguments of `cp' or `mv'. If
-KEEP-DATE is non-nil, preserve the time stamp when copying."
+KEEP-DATE is non-nil, preserve the time stamp when copying.
+PRESERVE-UID-GID is completely ignored."
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(tramp-fish-send-command
(tramp-shell-quote-argument v2-localname)))))
;; KEEP-DATE handling.
(when (and keep-date (functionp 'set-file-times))
- (apply 'set-file-times (list newname (nth 5 (file-attributes filename)))))
+ (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.
;; Read number of entries
(goto-char (point-min))
(condition-case nil
- (unless (integerp (setq num (read (current-buffer)))) (error))
+ (unless (integerp (setq num (read (current-buffer)))) (error nil))
(error (return nil)))
(forward-line)
(delete-region (point-min) (point))
;; Read return code
(goto-char (point-min))
(condition-case nil
- (unless (looking-at tramp-fish-continue-prompt-regexp) (error))
+ (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
(error (return nil)))
(forward-line)
(delete-region (point-min) (point))
;; Read return code
(goto-char (point-min))
(condition-case nil
- (unless (looking-at tramp-fish-ok-prompt-regexp) (error))
+ (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
(error (tramp-error
vec 'file-error
"`%s' does not return a valid Lisp expression: `%s'"
;; Read filesize
(goto-char (point-min))
(condition-case nil
- (unless (integerp (setq size (read (current-buffer)))) (error))
+ (unless (integerp (setq size (read (current-buffer)))) (error nil))
(error (return nil)))
(forward-line)
(delete-region (point-min) (point))
;; Read return code
(goto-char (point-min))
(condition-case nil
- (unless (looking-at tramp-fish-continue-prompt-regexp) (error))
+ (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
(error (return nil)))
(forward-line)
(delete-region (point-min) (point))
;; Read return code
(goto-char (+ (point-min) size))
(condition-case nil
- (unless (looking-at tramp-fish-ok-prompt-regexp) (error))
+ (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
(error (return nil)))
(delete-region (+ (point-min) size) (point-max))
size))))
(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-temporary-file-directory)))
+ (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-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)
HCoop / bpt / emacs.git / blobdiff