Sync with Tramp 2.0.47.

5 files changed, 149 insertions, 75 deletions

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index d0a7cf7b65f..6fa0433a574 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -172,7 +172,7 @@ This variable is local to each buffer.")
     (set-file-modes . tramp-smb-not-handled)
     (set-visited-file-modtime . tramp-smb-not-handled)
     (shell-command . tramp-smb-not-handled)
-    ;; `substitute-in-file-name' performed by default handler
+    (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
     (vc-registered . tramp-smb-not-handled)
     (verify-visited-file-modtime . tramp-smb-not-handled)
@@ -617,6 +617,13 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
 
   (delete-file filename))
 
+(defun tramp-smb-handle-substitute-in-file-name (filename)
+  "Like `handle-substitute-in-file-name' for tramp files.
+Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
+  (condition-case nil
+      (tramp-run-real-handler 'substitute-in-file-name (list filename))
+    (error filename)))
+
 (defun tramp-smb-handle-write-region
   (start end filename &optional append visit lockname confirm)
   "Like `write-region' for tramp files."
@@ -1084,54 +1091,6 @@ Return the difference in the format of a time value."
 	  (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
 
 
-;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
-;; Must be corrected.
-
-(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion)
-  "Changes \"$\" back to \"$$\" in minibuffer."
-  (if (funcall PC-completion-as-file-name-predicate)
-
-      (progn
-	;; Substitute file names
-	(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
-			     (funcall 'minibuffer-prompt-end))
-			(point-min)))
-	       (end (point-max))
-	       (str (substitute-in-file-name (buffer-substring beg end))))
-	  (delete-region beg end)
-	  (insert str)
-	  (ad-set-arg 2 (point)))
-
-	;; Do `PC-do-completion' without substitution
-	(let* (save)
-	  (fset 'save (symbol-function 'substitute-in-file-name))
- 	  (unwind-protect
- 	      (progn
- 		(fset 'substitute-in-file-name (symbol-function 'identity))
- 		ad-do-it)
- 	    (fset 'substitute-in-file-name (symbol-function 'save))))
-
-	;; Expand "$"
-	(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
-			     (funcall 'minibuffer-prompt-end))
-			(point-min)))
-	       (end (point-max))
-	       (str (buffer-substring beg end)))
-	  (delete-region beg end)
-	  (insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str)
-		      (replace-match "$$" nil nil str 1)
-		    str))))
-
-    ;; No file names. Behave unchanged.
-    ad-do-it))
-
-;; Activate advice.  Recent Emacsen don't need that.
-(when (functionp 'PC-do-completion)
-  (condition-case nil
-      (substitute-in-file-name "C$/")
-    (error
-     (ad-activate 'PC-do-completion))))
-
 (provide 'tramp-smb)
 
 ;;; TODO:
diff --git a/lisp/net/tramp-util.el b/lisp/net/tramp-util.el
index 2d828d27c51..1cd7f14dcd6 100644
--- a/lisp/net/tramp-util.el
+++ b/lisp/net/tramp-util.el
@@ -1,9 +1,9 @@
 ;;; -*- coding: iso-2022-7bit; -*-
 ;;; tramp-util.el --- Misc utility functions to use with Tramp
 
-;; Copyright (C) 2001  Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
 
-;; Author: Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;; Author: kai.grossjohann@gmx.net
 ;; Keywords: comm, extensions, processes
 
 ;; This file is free software; you can redistribute it and/or modify
@@ -32,6 +32,60 @@
 (require 'compile)
 (require 'tramp)
 
+;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
+;; specific functions, like compilation.
+;; The key remapping works since Emacs 21.4 only. Unknown for XEmacs.
+
+(when (fboundp 'define-minor-mode)
+
+  (defvar tramp-minor-mode-map (make-sparse-keymap)
+    "Keymap for Tramp minor mode.")
+
+  (define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
+    :group 'tramp
+    :global nil
+    :init-value nil
+    :lighter " Tramp"
+    :keymap tramp-minor-mode-map
+    (setq tramp-minor-mode
+	  (and tramp-minor-mode (tramp-tramp-file-p default-directory))))
+
+  (add-hook 'find-file-hooks 'tramp-minor-mode t)
+  (add-hook 'dired-mode-hook 'tramp-minor-mode t)
+
+  (defun tramp-remap-command (old-command new-command)
+    "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
+If remapping functionality for keymaps is defined, this happens for all
+bindings.  Otherwise, only bindings active during invocation are taken
+into account.  XEmacs menubar bindings are not changed by this."
+    (if (functionp 'command-remapping)
+	;; Emacs 21.4
+	(eval
+	 `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
+      ;; previous Emacs 21 versions.
+      (mapcar
+       '(lambda (x)
+	  (define-key tramp-minor-mode-map x new-command))
+       (where-is-internal old-command))))
+
+  (tramp-remap-command 'compile 'tramp-compile)
+  (tramp-remap-command 'recompile 'tramp-recompile)
+
+  ;; XEmacs has an own mimic for menu entries
+  (when (fboundp 'add-menu-button)
+    (funcall 'add-menu-button
+     '("Tools" "Compile")
+     ["Compile..."
+      (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
+      :active (fboundp 'compile)])
+    (funcall 'add-menu-button
+     '("Tools" "Compile")
+     ["Repeat Compilation"
+      (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
+      :active (fboundp 'compile)])))
+
+;; Utility functions.
+
 (defun tramp-compile (command)
   "Compile on remote host."
   (interactive
@@ -49,6 +103,16 @@
       (setq default-directory d)))
   (tramp-handle-shell-command command (get-buffer "*Compilation*"))
   (pop-to-buffer (get-buffer "*Compilation*"))
+  (tramp-minor-mode 1)
+  (compilation-minor-mode 1))
+
+(defun tramp-recompile ()
+  "Re-compile on remote host."
+  (interactive)
+  (save-some-buffers (not compilation-ask-about-save) nil)
+  (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
+  (pop-to-buffer (get-buffer "*Compilation*"))
+  (tramp-minor-mode 1)
   (compilation-minor-mode 1))
 
 (provide 'tramp-util)
diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el
index 3cc54eda650..c2a9ae737df 100644
--- a/lisp/net/tramp-vc.el
+++ b/lisp/net/tramp-vc.el
@@ -130,7 +130,8 @@ See `vc-do-command' for more information."
 	(save-excursion
 	  (save-window-excursion
 	    ;; Actually execute remote command
-	    (shell-command
+	    ;; `shell-command' cannot be used; it isn't magic in XEmacs.
+	    (tramp-handle-shell-command
 	     (mapconcat 'tramp-shell-quote-argument
 			(cons command squeezed) " ") t)
 	    ;;(tramp-wait-for-output)
@@ -190,7 +191,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
       (let ((w32-quote-process-args t))
         (when (eq okstatus 'async)
           (message "Tramp doesn't do async commands, running synchronously."))
-        (setq status (shell-command
+	;; `shell-command' cannot be used; it isn't magic in XEmacs.
+        (setq status (tramp-handle-shell-command
                       (mapconcat 'tramp-shell-quote-argument
                                  (cons command squeezed) " ") t))
         (when (or (not (integerp status))
@@ -285,7 +287,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
 	(save-excursion
 	  (save-window-excursion
 	    ;; Actually execute remote command
-	    (shell-command
+	    ;; `shell-command' cannot be used; it isn't magic in XEmacs.
+	    (tramp-handle-shell-command
 	     (mapconcat 'tramp-shell-quote-argument
 			(append (list command) args (list localname)) " ")
 	     (get-buffer-create"*vc-info*"))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 34572e98674..90bc30744c7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,7 +1,7 @@
 ;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Author: kai.grossjohann@gmx.net
 ;; Keywords: comm, processes
@@ -912,6 +912,15 @@ The answer will be provided by `tramp-action-terminal', which see."
   :group 'tramp
   :type 'regexp)
 
+(defcustom tramp-operation-not-permitted-regexp
+  (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
+	  (regexp-opt '("Operation not permitted") t))
+  "Regular expression matching keep-date problems in (s)cp operations.
+Copying has been performed successfully already, so this message can
+be ignored safely."
+  :group 'tramp
+  :type 'regexp)
+
 (defcustom tramp-process-alive-regexp
   ""
   "Regular expression indicating a process has finished.
@@ -2500,7 +2509,7 @@ if the remote host can't provide the modtime."
 		 (fa2 (file-attributes file2)))
 	     (if (and (not (equal (nth 5 fa1) '(0 0)))
 		      (not (equal (nth 5 fa2) '(0 0))))
-		 (< 0 (tramp-time-diff (nth 5 fa1) (nth 5 fa2)))
+		 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
 	       ;; If one of them is the dont-know value, then we can
 	       ;; still try to run a shell command on the remote host.
 	       ;; However, this only works if both files are Tramp
@@ -2822,10 +2831,8 @@ if the remote host can't provide the modtime."
   ;; At least one file a tramp file?
   (if (or (tramp-tramp-file-p filename)
           (tramp-tramp-file-p newname))
-      (let ((modes (file-modes filename)))
-	(tramp-do-copy-or-rename-file
-	 'copy filename newname ok-if-already-exists keep-date)
-	(set-file-modes newname modes))
+      (tramp-do-copy-or-rename-file
+       'copy filename newname ok-if-already-exists keep-date)
     (tramp-run-real-handler
      'copy-file
      (list filename newname ok-if-already-exists keep-date))))
@@ -2973,8 +2980,9 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
       (when keep-date
 	(when (and (not (null modtime))
 		   (not (equal modtime '(0 0))))
-	  (tramp-touch newname modtime))
-	(set-file-modes newname (file-modes filename))))
+	  (tramp-touch newname modtime)))
+      ;; Set the mode.
+      (set-file-modes newname (file-modes filename)))
     ;; If the operation was `rename', delete the original file.
     (unless (eq op 'copy)
       (delete-file filename))))
@@ -2994,15 +3002,34 @@ If KEEP-DATE is non-nil, preserve the time stamp when copying."
                        "Unknown operation `%s', must be `copy' or `rename'"
                        op)))))
     (save-excursion
-      (tramp-barf-unless-okay
+      (tramp-send-command
        multi-method method user host
        (format "%s %s %s"
                cmd
                (tramp-shell-quote-argument localname1)
-               (tramp-shell-quote-argument localname2))
-       nil 'file-error
-       "Copying directly failed, see buffer `%s' for details."
-       (buffer-name)))))
+               (tramp-shell-quote-argument localname2)))
+      (tramp-wait-for-output)
+      (goto-char (point-min))
+      (unless
+	  (or
+	   (and (eq op 'copy) keep-date
+		;; Mask cp -f error.
+		(re-search-forward tramp-operation-not-permitted-regexp nil t))
+	   (zerop (tramp-send-command-and-check
+		   multi-method method user host nil nil)))
+	(pop-to-buffer (current-buffer))
+	(signal 'file-error
+		(format "Copying directly failed, see buffer `%s' for details."
+			(buffer-name)))))
+    ;; Set the mode.
+    ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
+    ;;      where available?
+    (unless (or (eq op 'rename) keep-date)
+      (set-file-modes
+       (tramp-make-tramp-file-name multi-method method user host localname2)
+       (file-modes
+	(tramp-make-tramp-file-name
+	 multi-method method user host localname1))))))
 
 (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
   "Invoke rcp program to copy.
@@ -3122,7 +3149,11 @@ be a local filename.  The method used must be an out-of-band method."
 			       tramp-actions-copy-out-of-band))
       (kill-buffer trampbuf)
       (tramp-message
-       5 "Transferring %s to file %s...done" filename newname))
+       5 "Transferring %s to file %s...done" filename newname)
+
+      ;; Set the mode.
+      (unless keep-date
+	(set-file-modes newname (file-modes filename))))
 
     ;; If the operation was `rename', delete the original file.
     (unless (eq op 'copy)
@@ -4074,7 +4105,9 @@ ARGS are the arguments OPERATION has been called with."
      (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
    ; COMMAND
    ((member operation
-	    (list 'dired-call-process 'shell-command
+	    (list 'dired-call-process-command
+                  ; Emacs only
+		  'shell
                   ; Post Emacs 21.3 only
                   'process-file
 	          ; XEmacs only
@@ -4908,7 +4941,10 @@ USER the array of user names, HOST the array of host names."
 
 (defun tramp-get-buffer (multi-method method user host)
   "Get the connection buffer to be used for USER at HOST using METHOD."
-  (get-buffer-create (tramp-buffer-name multi-method method user host)))
+  (with-current-buffer
+      (get-buffer-create (tramp-buffer-name multi-method method user host))
+    (setq buffer-undo-list t)
+    (current-buffer)))
 
 (defun tramp-debug-buffer-name (multi-method method user host)
   "A name for the debug buffer for USER at HOST using METHOD."
@@ -4922,7 +4958,11 @@ USER the array of user names, HOST the array of host names."
 
 (defun tramp-get-debug-buffer (multi-method method user host)
   "Get the debug buffer for USER at HOST using METHOD."
-  (get-buffer-create (tramp-debug-buffer-name multi-method method user host)))
+  (with-current-buffer
+      (get-buffer-create
+       (tramp-debug-buffer-name multi-method method user host))
+    (setq buffer-undo-list t)
+    (current-buffer)))
 
 (defun tramp-find-executable (multi-method method user host
                                          progname dirlist ignore-tilde)
@@ -5214,8 +5254,16 @@ The terminal type can be configured with `tramp-terminal-type'."
 	((or (and (memq (process-status p) '(stop exit))
 		  (not (zerop (process-exit-status p))))
 	     (memq (process-status p) '(signal)))
-	 (tramp-message 9 "Process has died.")
-	 (throw 'tramp-action 'process-died))
+	 ;; `scp' could have copied correctly, but set modes could have failed.
+	 ;; This can be ignored.
+	 (goto-char (point-min))
+	 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
+	     (progn
+	       (tramp-message 10 "'set mode' error ignored.")
+	       (tramp-message 9 "Process has finished.")
+	       (throw 'tramp-action 'ok))
+	   (tramp-message 9 "Process has died.")
+	   (throw 'tramp-action 'process-died)))
 	(t nil)))
 
 ;; The following functions are specifically for multi connections.
@@ -6336,7 +6384,7 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
       (save-excursion
 	(goto-char start-point)
 	(when (looking-at (regexp-quote tramp-last-cmd))
-	  (delete-region (point) (forward-line 1)))))
+	  (delete-region (point) (progn (forward-line 1) (point))))))
     ;; Add output to debug buffer if appropriate.
     (when tramp-debug-buffer
       (append-to-buffer
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 866d6e5647d..a4aced24257 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -30,7 +30,7 @@
 ;; are auto-frobbed from configure.ac, so you should edit that file and run
 ;; "autoconf && ./configure" to change them.
 
-(defconst tramp-version "2.0.46"
+(defconst tramp-version "2.0.47"
   "This version of Tramp.")
 
 (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"