From: Michael Albinus Date: Tue, 17 Jul 2007 21:10:07 +0000 (+0000) Subject: * net/tramp.el (tramp-handle-file-remote-p): Handle optional X-Git-Tag: emacs-pretest-23.0.90~11863 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ce3f516fed03961e3da793f35b93fe6e9f5c0e0d;p=emacs.git * net/tramp.el (tramp-handle-file-remote-p): Handle optional parameter IDENTIFICATION. (tramp-handle-set-file-times): New defun. Replaces `tramp-touch'. (tramp-file-name-handler-alist, tramp-file-name-for-operation): Add entry for `set-file-times'. (tramp-do-copy-or-rename-file-via-buffer) (tramp-do-copy-or-rename-file-out-of-band): Use `set-file-times'. (tramp-handle-unhandled-file-name-directory): Rewrite. (tramp-convert-file-attributes): Add error handling when inode is extraordinary big. (tramp-get-inode): Change parameter from FILE to VEC. (tramp-handle-start-file-process ): Use (current-buffer) if BUFFER is NIL. This is according to the specification. Goto (point-max) when ready. (tramp-handle-shell-command): Rewrite completely, using `process-file' and `start-file-process'. (tramp-methods, tramp-find-shell) (tramp-open-connection-setup-interactive-shell) (tramp-maybe-open-connection): Guard against $PROMPT_COMMAND shell var. Reported by Steve Youngs . * net/tramp-fish.el (tramp-fish-file-name-handler-alist): Add entry for `set-file-times'. Rename `start-process' into `start-file-process'. Remove `call-process' entry. (tramp-fish-handle-set-file-times): New defun. (tramp-fish-handle-executable-find): Use `process-file'. (tramp-fish-handle-process-file): New defun. Replaces `tramp-fish-handle-call-process'. (tramp-fish-do-copy-or-rename-file-directly): Use `set-file-times'. (tramp-fish-get-file-entries): Change `tramp-get-inode' parameter. * net/tramp-smb.el (tramp-smb-handle-file-attributes): Change `tramp-get-inode' parameter. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 844aa761019..be77e72e924 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,52 @@ +2007-07-17 Michael Albinus + + * files.el (file-remote-p): Introduce optional parameter + IDENTIFICATION. + + * recentf.el (recentf-keep-default-predicate): Adapt call of + `file-remote-p'. + + * progmodes/grep.el (grep-probe): Use `process-file'. + (grep-compute-defaults): Handle variables host specific. + + * net/ange-ftp.el: (ange-ftp-file-remote-p): Handle optional + parameter IDENTIFICATION. + + * net/tramp.el (tramp-handle-file-remote-p): Handle optional + parameter IDENTIFICATION. + (tramp-handle-set-file-times): New defun. Replaces `tramp-touch'. + (tramp-file-name-handler-alist, tramp-file-name-for-operation): + Add entry for `set-file-times'. + (tramp-do-copy-or-rename-file-via-buffer) + (tramp-do-copy-or-rename-file-out-of-band): Use `set-file-times'. + (tramp-handle-unhandled-file-name-directory): Rewrite. + (tramp-convert-file-attributes): Add error handling when inode is + extraordinary big. + (tramp-get-inode): Change parameter from FILE to VEC. + (tramp-handle-start-file-process ): Use (current-buffer) if BUFFER + is NIL. This is according to the specification. Goto (point-max) + when ready. + (tramp-handle-shell-command): Rewrite completely, using + `process-file' and `start-file-process'. + (tramp-methods, tramp-find-shell) + (tramp-open-connection-setup-interactive-shell) + (tramp-maybe-open-connection): Guard against $PROMPT_COMMAND shell + var. Reported by Steve Youngs . + + * net/tramp-fish.el (tramp-fish-file-name-handler-alist): Add + entry for `set-file-times'. Rename `start-process' into + `start-file-process'. Remove `call-process' entry. + (tramp-fish-handle-set-file-times): New defun. + (tramp-fish-handle-executable-find): Use `process-file'. + (tramp-fish-handle-process-file): New defun. Replaces + `tramp-fish-handle-call-process'. + (tramp-fish-do-copy-or-rename-file-directly): Use + `set-file-times'. + (tramp-fish-get-file-entries): Change `tramp-get-inode' parameter. + + * net/tramp-smb.el (tramp-smb-handle-file-attributes): Change + `tramp-get-inode' parameter. + 2007-07-17 Stefan Monnier * vc-bzr.el (vc-bzr-version, vc-bzr-at-least-version) diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el index e370c54f902..8c650b550e9 100644 --- a/lisp/net/tramp-fish.el +++ b/lisp/net/tramp-fish.el @@ -263,6 +263,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-times . tramp-fish-handle-set-file-times) (set-visited-file-modtime . ignore) (shell-command . tramp-handle-shell-command) (substitute-in-file-name . tramp-handle-substitute-in-file-name) @@ -271,9 +272,8 @@ Used instead of analyzing error codes of commands.") (verify-visited-file-modtime . ignore) (write-region . tramp-fish-handle-write-region) (executable-find . tramp-fish-handle-executable-find) - (start-process . ignore) - (call-process . tramp-fish-handle-call-process) - (process-file . tramp-handle-process-file) + (start-file-process . ignore) + (process-file . tramp-fish-handle-process-file) ) "Alist of handler functions for Tramp FISH method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -698,6 +698,15 @@ target of the symlink differ." (tramp-error v 'file-error "Error while changing file's mode %s" filename)))) +(defun tramp-fish-handle-set-file-times (filename &optional time) + "Like `set-file-times' for Tramp files." + (with-parsed-tramp-file-name filename nil + (let ((time (if (or (null time) (equal time '(0 0))) (current-time) time))) + (zerop (process-file + "touch" nil nil nil "-t" + (format-time-string "%Y%m%d%H%M.%S" time) + (tramp-shell-quote-argument localname)))))) + (defun tramp-fish-handle-write-region (start end filename &optional append visit lockname confirm) "Like `write-region' for Tramp files." @@ -731,14 +740,14 @@ target of the symlink differ." (defun tramp-fish-handle-executable-find (command) "Like `executable-find' for Tramp files." (with-temp-buffer - (if (zerop (call-process "which" nil t nil command)) + (if (zerop (process-file "which" nil t nil command)) (progn (goto-char (point-min)) (buffer-substring (point-min) (tramp-line-end-position)))))) -(defun tramp-fish-handle-call-process +(defun tramp-fish-handle-process-file (program &optional infile destination display &rest args) - "Like `call-process' for Tramp files." + "Like `process-file' for Tramp files." ;; The implementation is not complete yet. (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) @@ -926,11 +935,8 @@ KEEP-DATE is non-nil, preserve the time stamp when copying." (tramp-shell-quote-argument v1-localname) (tramp-shell-quote-argument v2-localname))))) ;; KEEP-DATE handling. - (when keep-date - (let ((modtime (nth 5 (file-attributes filename)))) - (when (and (not (null modtime)) - (not (equal modtime '(0 0)))) - (tramp-touch newname modtime)))) + (when (and keep-date (functionp 'set-file-times)) + (apply 'set-file-times (list newname (nth 5 (file-attributes filename))))) ;; Set the mode. (set-file-modes newname (file-modes filename))) @@ -942,7 +948,8 @@ Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME SIZE MODE WEIRD INODE DEVICE)." (block nil (with-current-buffer (tramp-get-buffer vec) - ;; #LIST does not work properly with trailing "/", at least in .fishsrv.pl + ;; #LIST does not work properly with trailing "/", at least in + ;; .fishsrv.pl. (when (string-match "/$" localname) (setq localname (concat localname "."))) @@ -974,7 +981,7 @@ SIZE MODE WEIRD INODE DEVICE)." ;; Add inode and device. (add-to-list 'res (append item - (list (tramp-get-inode (car item)) + (list (tramp-get-inode vec) (tramp-get-device vec)))))) ;; Read return code diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 981073f7126..c8ea9932f96 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -346,7 +346,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (assoc (file-name-nondirectory filename) entries))) (uid (if (and id-format (equal id-format 'string)) "nobody" -1)) (gid (if (and id-format (equal id-format 'string)) "nogroup" -1)) - (inode (tramp-get-inode filename)) + (inode (tramp-get-inode v)) (device (tramp-get-device v))) ;; Check result. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 021d3db6fac..792233925fc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -571,8 +571,9 @@ files conditionalize this setup based on the TERM environment variable." ("plinkx" (tramp-login-program "plink") (tramp-login-args (("-load" "%h") ("-t") - (,(format "env 'TERM=%s' 'PS1=$ '" - tramp-terminal-type)) + (,(format + "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '" + tramp-terminal-type)) ("/bin/sh"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -1772,6 +1773,7 @@ This is used to map a mode number to a permission string.") (copy-file . tramp-handle-copy-file) (rename-file . tramp-handle-rename-file) (set-file-modes . tramp-handle-set-file-modes) + (set-file-times . tramp-handle-set-file-times) (make-directory . tramp-handle-make-directory) (delete-directory . tramp-handle-delete-directory) (delete-file . tramp-handle-delete-file) @@ -2493,6 +2495,40 @@ of." (tramp-error v 'file-error "Error while changing file's mode %s" filename)))) +(defun tramp-handle-set-file-times (filename &optional time) + "Like `set-file-times' for Tramp files." + (zerop + (if (file-remote-p filename) + (with-parsed-tramp-file-name filename nil + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time)) + (utc + ;; With GNU Emacs, `format-time-string' has an + ;; optional parameter UNIVERSAL. This is preferred, + ;; because we could handle the case when the remote + ;; host is located in a different time zone as the + ;; local host. + (and (functionp 'subr-arity) + (subrp (symbol-function 'format-time-string)) + (= 3 (cdr (funcall (symbol-function 'subr-arity) + (symbol-function + 'format-time-string))))))) + (tramp-send-command-and-check + v (format "%s touch -t %s %s" + (if utc "TZ=UTC; export TZ;" "") + (if utc + (format-time-string "%Y%m%d%H%M.%S" time t) + (format-time-string "%Y%m%d%H%M.%S" time)) + (tramp-shell-quote-argument localname))))) + ;; We handle also the local part, because in older Emacsen, + ;; without `set-file-times', this function is an alias for this. + ;; We are local, so we don't need the UTC settings. + (call-process + "touch" nil nil nil "-t" + (format-time-string "%Y%m%d%H%M.%S" time) + (tramp-shell-quote-argument filename))))) + ;; Simple functions using the `test' command. (defun tramp-handle-file-executable-p (filename) @@ -2926,10 +2962,8 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." (jka-compr-inhibit t)) (write-region (point-min) (point-max) newname)))) ;; KEEP-DATE handling. - (when keep-date - (when (and (not (null modtime)) - (not (equal modtime '(0 0)))) - (tramp-touch newname modtime))) + (when (and keep-date (functionp 'set-file-times)) + (apply 'set-file-times (list newname modtime))) ;; Set the mode. (set-file-modes newname (file-modes filename)) ;; If the operation was `rename', delete the original file. @@ -3078,8 +3112,9 @@ be a local filename. The method used must be an out-of-band method." (tramp-message v 0 "Transferring %s to %s...done" filename newname) ;; Handle KEEP-DATE argument. - (when (and keep-date (not copy-keep-date)) - (set-file-times newname (nth 5 (file-attributes filename)))) + (when (and keep-date (not copy-keep-date) (functionp 'set-file-times)) + (apply 'set-file-times + (list newname (nth 5 (file-attributes filename))))) ;; Set the mode. (unless (and keep-date copy-keep-date) @@ -3282,8 +3317,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; CCC is this the right thing to do? (defun tramp-handle-unhandled-file-name-directory (filename) "Like `unhandled-file-name-directory' for Tramp files." - (with-parsed-tramp-file-name filename nil - (expand-file-name (tramp-make-tramp-file-name method user host "~/")))) + (expand-file-name "~/")) ;; Canonicalization of file names. @@ -3446,9 +3480,8 @@ beginning of local filename are not substituted." (tramp-set-connection-property v "process-name" name) (tramp-set-connection-property v "process-buffer" - (get-buffer-create - ;; BUFFER can be nil. - (or buffer (generate-new-buffer-name (tramp-buffer-name v))))) + ;; BUFFER can be nil. + (get-buffer-create (or buffer (current-buffer)))) ;; Activate narrowing in order to save BUFFER contents. (with-current-buffer (tramp-get-connection-buffer v) (narrow-to-region (point-max) (point-max))) @@ -3466,7 +3499,9 @@ beginning of local filename are not substituted." ;; Return process. (tramp-get-connection-process v)) ;; Save exit. - (with-current-buffer (tramp-get-connection-buffer v) (widen)) + (with-current-buffer (tramp-get-connection-buffer v) + (widen) + (goto-char (point-max))) (tramp-set-connection-property v "process-name" nil) (tramp-set-connection-property v "process-buffer" nil)))) @@ -3575,12 +3610,33 @@ beginning of local filename are not substituted." (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (with-parsed-tramp-file-name default-directory nil - (let ((shell-file-name - (tramp-get-connection-property v "remote-shell" "/bin/sh")) - (shell-command-switch "-c")) - (tramp-run-real-handler - 'shell-command (list command output-buffer error-buffer))))) + (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + (args (split-string (substring command 0 asynchronous) " ")) + (output-buffer + (or output-buffer + (if asynchronous + "*Async Shell Command*" + "*Shell Command Output*"))) + (buffer + (if (and (not asynchronous) (bufferp error-buffer)) + (with-parsed-tramp-file-name default-directory nil + (list output-buffer (tramp-make-tramp-temp-file v))) + output-buffer))) + + (prog1 + ;; Run the process. We cannot use `process-file' and + ;; `start-file-process', because these functions might not + ;; exist in older Emacsen. + (if (integerp asynchronous) + (apply 'tramp-handle-start-file-process + "*Async Shell*" buffer args) + (apply 'tramp-handle-process-file + (car args) nil buffer nil (cdr args))) + ;; Insert error messages if they were separated. + (when (listp buffer) + (with-current-buffer error-buffer + (insert-file-contents (cadr buffer))) + (delete-file (cadr buffer)))))) ;; File Editing. @@ -3657,14 +3713,18 @@ beginning of local filename are not substituted." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfil))) -(defun tramp-handle-file-remote-p (filename &optional connected) +(defun tramp-handle-file-remote-p (file &optional identification connected) "Like `file-remote-p' for Tramp files." (when (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil (and (or (not connected) (let ((p (tramp-get-connection-process v))) (and p (processp p) (memq (process-status p) '(run open))))) - (tramp-make-tramp-file-name method user host ""))))) + (cond + ((eq identification 'method) method) + ((eq identification 'user) user) + ((eq identification 'host) host) + (t (tramp-make-tramp-file-name method user host ""))))))) (defun tramp-handle-insert-file-contents (filename &optional visit beg end replace) @@ -4025,6 +4085,8 @@ ARGS are the arguments OPERATION has been called with." 'load 'make-directory 'make-directory-internal 'set-file-modes 'substitute-in-file-name 'unhandled-file-name-directory 'vc-registered + ; Emacs 22 only + 'set-file-times ; XEmacs only 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename @@ -4886,40 +4948,6 @@ hosts, or files, disagree." (tramp-shell-quote-argument v1-localname) (tramp-shell-quote-argument v2-localname)))))) -(defun tramp-touch (file time) - "Set the last-modified timestamp of the given file. -TIME is an Emacs internal time value as returned by `current-time'." - (let* ((utc - ;; With GNU Emacs, `format-time-string' has an optional - ;; parameter UNIVERSAL. This is preferred. - (and (functionp 'subr-arity) - (subrp (symbol-function 'format-time-string)) - (= 3 (cdr (funcall (symbol-function 'subr-arity) - (symbol-function 'format-time-string)))))) - (touch-time - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time))) - (default-directory (file-name-directory file))) - - (if (eq (tramp-find-foreign-file-name-handler file) - 'tramp-sh-file-name-handler) - (with-parsed-tramp-file-name file nil - (tramp-send-command - v (format "%s touch -t %s %s" - (if utc "TZ=UTC; export TZ;" "") - touch-time - (tramp-shell-quote-argument localname)))) - (with-temp-buffer - (shell-command - (format "%s touch -t %s %s" - (if utc "TZ=UTC; export TZ;" "") - touch-time - (tramp-shell-quote-argument - (if (tramp-tramp-file-p file) - (with-parsed-tramp-file-name file nil localname) file))) - (current-buffer)))))) - (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." ;; We must use `tramp-file-name-real-host', because for gateway @@ -5179,7 +5207,8 @@ file exists and nonzero exit status otherwise." (when extra-args (setq shell (concat shell " " extra-args)))) (tramp-message vec 5 "Starting remote shell `%s' for tilde expansion..." shell) - (tramp-send-command-internal vec (concat "PS1='$ ' exec " shell)) + (tramp-send-command-internal + vec (concat "PROMPT_COMMAND='' PS1='$ ' exec " shell)) (tramp-message vec 5 "Setting remote shell prompt...") ;; Douglas Gray Stephens says that we ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the @@ -5187,7 +5216,7 @@ file exists and nonzero exit status otherwise." ;; as well. (tramp-send-command vec - (format "PS1='%s%s%s'; PS2=''; PS3=''" + (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''" tramp-rsh-end-of-line tramp-end-of-output tramp-rsh-end-of-line)) @@ -5455,10 +5484,11 @@ process to set up. VEC specifies the connection." ;; makes it work under `rc', too. We also unset the variable $ENV ;; because that is read by some sh implementations (eg, bash when ;; called as sh) on startup; this way, we avoid the startup file - ;; clobbering $PS1. + ;; clobbering $PS1. $PROMP_COMMAND is another way to set the prompt + ;; in /bin/bash, it must be discarded as well. (tramp-send-command-internal vec - (format "exec env 'ENV=' 'PS1=$ ' %s" + (format "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' %s" (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh))) (tramp-message vec 5 "Setting up remote shell environment") @@ -5512,7 +5542,7 @@ process to set up. VEC specifies the connection." ;; send "echo are you awake". (tramp-send-command vec - (format "PS1='%s%s%s'; PS2=''; PS3=''" + (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''" tramp-rsh-end-of-line tramp-end-of-output tramp-rsh-end-of-line)) @@ -5893,6 +5923,7 @@ connection if a previous connection has died for some reason." (when (and p (processp p)) (delete-process p)) (setenv "TERM" tramp-terminal-type) + (setenv "PROMPT_COMMAND") (setenv "PS1" "$ ") (let* ((target-alist (tramp-compute-multi-hops vec)) (process-environment (copy-sequence process-environment)) @@ -6243,17 +6274,24 @@ Return ATTR." ;; Convert inode. (unless (listp (nth 10 attr)) (setcar (nthcdr 10 attr) - (list (floor (nth 10 attr) 65536) - (floor (mod (nth 10 attr) 65536))))) + (condition-case nil + (list (floor (nth 10 attr) 65536) + (floor (mod (nth 10 attr) 65536))) + ;; Inodes can be incredible huge. We must hide this. + (error (tramp-get-inode vec))))) ;; Set virtual device number. (setcar (nthcdr 11 attr) (tramp-get-device vec)) attr) -(defun tramp-get-inode (file) +(defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." - (let ((string (directory-file-name file))) + (let ((string (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + ""))) (unless (assoc string tramp-inodes) (add-to-list 'tramp-inodes (list string (length tramp-inodes))))