Mercurial > emacs

changeset 82808:6e5814967ffb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* net/tramp.el (tramp-local-host-p): New defun. (tramp-handle-file-local-copy, tramp-handle-write-region): Implement fast track when being on the local host. (tramp-file-name-handler): Don't set "started" property. It shall be reserved for the "ftp" method. (tramp-make-copy-program-file-name): Use `tramp-file-name-real-host'. * net/tramp-ftp.el (top): Autoload `tramp-set-connection-property'. (tramp-ftp-file-name-handler): Set "started" property.
author Michael Albinus <michael.albinus@gmx.de>
date Fri, 24 Aug 2007 05:27:22 +0000
parents 1fbf8f4df1a7
children 496cd44c3983
files lisp/ChangeLog lisp/net/tramp-ftp.el lisp/net/tramp.el
diffstat 3 files changed, 115 insertions(+), 82 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Aug 24 03:08:13 2007 +0000
+++ b/lisp/ChangeLog	Fri Aug 24 05:27:22 2007 +0000
@@ -1,3 +1,15 @@
+2007-08-24  Michael Albinus  <michael.albinus@gmx.de>
+
+	* net/tramp.el (tramp-local-host-p): New defun.
+	(tramp-handle-file-local-copy, tramp-handle-write-region):
+	Implement fast track when being on the local host.
+	(tramp-file-name-handler): Don't set "started" property.  It shall
+	be reserved for the "ftp" method.
+	(tramp-make-copy-program-file-name): Use `tramp-file-name-real-host'.
+
+	* net/tramp-ftp.el (top): Autoload `tramp-set-connection-property'.
+	(tramp-ftp-file-name-handler):  Set "started" property.
+
 2007-08-24  Ulrich Mueller  <ulm@gentoo.org>  (tiny change)
 
 	* files.el (backup-buffer-copy): Don't wrap delete in
@@ -1630,7 +1642,7 @@
 
 	Sync with Tramp 2.1.10.
 
-	* net/tramp.el (tramp-get-ls-command): Fyx typo.
+	* net/tramp.el (tramp-get-ls-command): Fix typo.
 
 	* net/trampver.el: Update release number.
 
--- a/lisp/net/tramp-ftp.el	Fri Aug 24 03:08:13 2007 +0000
+++ b/lisp/net/tramp-ftp.el	Fri Aug 24 05:27:22 2007 +0000
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (require 'tramp)
+(autoload 'tramp-set-connection-property "tramp-cache")
 
 (eval-when-compile (require 'custom))
 
@@ -137,19 +138,25 @@
 	  (ange-ftp-ftp-name-arg "")
 	  (ange-ftp-ftp-name-res nil))
       (cond
-       ;; If argument is a symlink, `file-directory-p' and `file-exists-p'
-       ;; call the traversed file recursively. So we cannot disable the
-       ;; file-name-handler this case.
+       ;; If argument is a symlink, `file-directory-p' and
+       ;; `file-exists-p' call the traversed file recursively. So we
+       ;; cannot disable the file-name-handler this case.  We set the
+       ;; connection property "started" in order to put the remote
+       ;; location into the cache, which is helpful for further
+       ;; completion.
        ((memq operation '(file-directory-p file-exists-p))
-	(apply 'ange-ftp-hook-function operation args))
-	;; Normally, the handlers must be discarded
-	(t (let* ((inhibit-file-name-handlers
-		   (list 'tramp-file-name-handler
-			 'tramp-completion-file-name-handler
-			 (and (eq inhibit-file-name-operation operation)
-			      inhibit-file-name-handlers)))
-		  (inhibit-file-name-operation operation))
-	     (apply 'ange-ftp-hook-function operation args)))))))
+	(if (apply 'ange-ftp-hook-function operation args)
+	    (with-parsed-tramp-file-name (car args) nil
+	      (tramp-set-connection-property v "started" t))
+	  nil))
+       ;; Normally, the handlers must be discarded.
+       (t (let* ((inhibit-file-name-handlers
+		  (list 'tramp-file-name-handler
+			'tramp-completion-file-name-handler
+			(and (eq inhibit-file-name-operation operation)
+			     inhibit-file-name-handlers)))
+		 (inhibit-file-name-operation operation))
+	    (apply 'ange-ftp-hook-function operation args)))))))
 
 (defun tramp-ftp-file-name-p (filename)
   "Check if it's a filename that should be forwarded to Ange-FTP."
--- a/lisp/net/tramp.el	Fri Aug 24 03:08:13 2007 +0000
+++ b/lisp/net/tramp.el	Fri Aug 24 05:27:22 2007 +0000
@@ -3665,14 +3665,9 @@
 
 (defun tramp-handle-file-local-copy (filename)
   "Like `file-local-copy' for Tramp files."
+
   (with-parsed-tramp-file-name filename nil
-    (let (;; We used to bind the following as late as possible.
-	  ;; loc-dec was bound directly before the if statement that
-	  ;; checks them.  But the functions tramp-get-* might invoke
-	  ;; the "are you awake" check in `tramp-maybe-open-connection',
-	  ;; which is an unfortunate time since we rely on the buffer
-	  ;; contents at that spot.
-	  (rem-enc (tramp-get-remote-coding v "remote-encoding"))
+    (let ((rem-enc (tramp-get-remote-coding v "remote-encoding"))
 	  (loc-dec (tramp-get-local-coding v "local-decoding"))
 	  tmpfil)
       (unless (file-exists-p filename)
@@ -3681,55 +3676,59 @@
 	 "Cannot make local copy of non-existing file `%s'" filename))
       (setq tmpfil (tramp-make-temp-file filename))
 
-      (cond ((and (tramp-method-out-of-band-p v)
-		  (> (nth 7 (file-attributes filename))
-		     tramp-copy-size-limit))
-	     ;; `copy-file' handles out-of-band methods
-	     (copy-file filename tmpfil t t))
-
-	    (rem-enc
-	     ;; Use inline encoding for file transfer.
-	     (save-excursion
-	       (tramp-message v 5 "Encoding remote file %s..." filename)
-	       (tramp-barf-unless-okay
-		v
-		(concat rem-enc " < " (tramp-shell-quote-argument localname))
-		"Encoding remote file failed")
-
-	       (tramp-message v 5 "Decoding remote file %s..." filename)
-	       ;; Here is where loc-dec used to be let-bound.
-	       (if (and (symbolp loc-dec) (fboundp loc-dec))
-		   ;; If local decoding is a function, we call it.  We
-		   ;; must disable multibyte, because
-		   ;; `uudecode-decode-region' doesn't handle it
-		   ;; correctly.
-		   (unwind-protect
-		       (with-temp-buffer
-			 (set-buffer-multibyte nil)
-			 (insert-buffer-substring (tramp-get-buffer v))
-			 (tramp-message
-			  v 5 "Decoding remote file %s with function %s..."
-			  filename loc-dec)
-			 (funcall loc-dec (point-min) (point-max))
-			 (let ((coding-system-for-write 'binary))
-			   (write-region (point-min) (point-max) tmpfil))))
-		 ;; If tramp-decoding-function is not defined for this
-		 ;; method, we invoke tramp-decoding-command instead.
-		 (let ((tmpfil2 (tramp-make-temp-file filename)))
-		   (let ((coding-system-for-write 'binary))
-		     (write-region (point-min) (point-max) tmpfil2))
-		   (tramp-message
-		    v 5 "Decoding remote file %s with command %s..."
-		    filename loc-dec)
-		   (tramp-call-local-coding-command
-		    loc-dec tmpfil2 tmpfil)
-		   (delete-file tmpfil2)))
-	       (tramp-message v 5 "Decoding remote file %s...done" filename)
-	       ;; Set proper permissions.
-	       (set-file-modes tmpfil (file-modes filename))))
-
-	    (t (tramp-error
-		v 'file-error "Wrong method specification for `%s'" method)))
+      (cond
+       ;; Fast track on local machine.
+       ((tramp-local-host-p v)
+	(tramp-do-copy-or-rename-file-directly 'copy v localname tmpfil t)
+	(tramp-send-command v (format "chown %s %s" (user-login-name) tmpfil)))
+
+       ;; `copy-file' handles out-of-band methods.
+       ((and (tramp-method-out-of-band-p v)
+	     (> (nth 7 (file-attributes filename)) tramp-copy-size-limit))
+	(copy-file filename tmpfil t t))
+
+       ;; Use inline encoding for file transfer.
+       (rem-enc
+	(save-excursion
+	  (tramp-message v 5 "Encoding remote file %s..." filename)
+	  (tramp-barf-unless-okay
+	   v (format "%s < %s" rem-enc (tramp-shell-quote-argument localname))
+	   "Encoding remote file failed")
+	  (tramp-message v 5 "Encoding remote file %s...done" filename)
+
+	  (tramp-message v 5 "Decoding remote file %s..." filename)
+	  (if (and (symbolp loc-dec) (fboundp loc-dec))
+	      ;; If local decoding is a function, we call it.  We must
+	      ;; disable multibyte, because `uudecode-decode-region'
+	      ;; doesn't handle it correctly.
+	      (unwind-protect
+		  (with-temp-buffer
+		    (set-buffer-multibyte nil)
+		    (insert-buffer-substring (tramp-get-buffer v))
+		    (tramp-message
+		     v 5 "Decoding remote file %s with function %s..."
+		     filename loc-dec)
+		    (funcall loc-dec (point-min) (point-max))
+		    (let ((coding-system-for-write 'binary))
+		      (write-region (point-min) (point-max) tmpfil))))
+	    ;; If tramp-decoding-function is not defined for this
+	    ;; method, we invoke tramp-decoding-command instead.
+	    (let ((tmpfil2 (tramp-make-temp-file filename)))
+	      (let ((coding-system-for-write 'binary))
+		(write-region (point-min) (point-max) tmpfil2))
+	      (tramp-message
+	       v 5 "Decoding remote file %s with command %s..."
+	       filename loc-dec)
+	      (tramp-call-local-coding-command loc-dec tmpfil2 tmpfil)
+	      (delete-file tmpfil2)))
+	  (tramp-message v 5 "Decoding remote file %s...done" filename)
+	  ;; Set proper permissions.
+	  (set-file-modes tmpfil (file-modes filename))))
+
+       ;; Oops, I don't know what to do.
+       (t (tramp-error
+	   v 'file-error "Wrong method specification for `%s'" method)))
+
       (run-hooks 'tramp-handle-file-local-copy-hook)
       tmpfil)))
 
@@ -3927,20 +3926,26 @@
       ;; the backup file.  This case `save-buffer' handles
       ;; permissions.
       (when modes (set-file-modes tmpfil modes))
+
       ;; This is a bit lengthy due to the different methods possible for
       ;; file transfer.  First, we check whether the method uses an rcp
       ;; program.  If so, we call it.  Otherwise, both encoding and
       ;; decoding command must be specified.  However, if the method
       ;; _also_ specifies an encoding function, then that is used for
       ;; encoding the contents of the tmp file.
-      (cond ((and (tramp-method-out-of-band-p v)
+      (cond ;; Fast track on local machine.
+            ((tramp-local-host-p v)
+	     (tramp-do-copy-or-rename-file-directly
+	      'rename v tmpfil localname t))
+
+	    ;; `copy-file' handles out-of-band methods
+	    ((and (tramp-method-out-of-band-p v)
 		  (integerp start)
 		  (> (- end start) tramp-copy-size-limit))
-	     ;; `copy-file' handles out-of-band methods
-	     (copy-file tmpfil filename t t))
-
+	     (rename-file tmpfil filename t))
+
+	    ;; Use inline file transfer
 	    (rem-dec
-	     ;; Use inline file transfer
 	     ;; Encode tmpfil
 	     (tramp-message v 5 "Encoding region...")
 	     (unwind-protect
@@ -4025,14 +4030,19 @@
 		       filename rem-dec)))
 		   (tramp-message
 		    v 5 "Decoding region into remote file %s...done" filename)
-		   (tramp-flush-file-property v localname))))
+		   (tramp-flush-file-property v localname))
+
+	       ;; Save exit.
+	       (delete-file tmpfil)))
+
+	    ;; That's not expected.
 	    (t
 	     (tramp-error
 	      v 'file-error
 	      (concat "Method `%s' should specify both encoding and "
 		      "decoding command or an rcp program")
 	      method)))
-      (delete-file tmpfil)
+
       (when (or (eq visit t) (stringp visit))
 	(set-visited-file-modtime
 	 ;; We must pass modtime explicitely, because filename can be different
@@ -4198,10 +4208,7 @@
 	  filename)
 	 ;; Call the backend function.  Set a connection property
 	 ;; first, it will be reused for user/host name completion.
-	 (foreign
-	  (unless (zerop (length localname))
-	    (tramp-set-connection-property v "started" nil))
-	  (apply foreign operation args))
+	 (foreign (apply foreign operation args))
 	 ;; Nothing to do for us.
 	 (t (tramp-run-real-handler operation args)))))))
 
@@ -6502,8 +6509,7 @@
 (defun tramp-make-copy-program-file-name (vec)
   "Create a file name suitable to be passed to `rcp' and workalikes."
   (let ((user (tramp-file-name-user vec))
-	(host (car (split-string
-		    (tramp-file-name-host vec) tramp-prefix-port-regexp)))
+	(host (tramp-file-name-real-host vec))
 	(localname (tramp-shell-quote-argument
 		    (tramp-file-name-localname vec))))
     (if (not (zerop (length user)))
@@ -6514,6 +6520,14 @@
   "Return t if this is an out-of-band method, nil otherwise."
   (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program))
 
+(defun tramp-local-host-p (vec)
+  "Return t if this points to the local host, nil otherwise."
+  (let ((host (tramp-file-name-real-host vec)))
+    (and
+     (stringp host)
+     (string-match
+      (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host))))
+
 ;; Variables local to connection.
 
 (defun tramp-get-remote-path (vec)