From 01917a18b40405b2cb7eaf279e8db13875c9c5be Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 16 Jan 2005 13:18:31 +0000 Subject: [PATCH] Sync with Tramp 2.0.47. --- lisp/ChangeLog | 46 ++++++++++++++++++++++ lisp/net/tramp-smb.el | 57 ++++----------------------- lisp/net/tramp-util.el | 68 +++++++++++++++++++++++++++++++- lisp/net/tramp-vc.el | 9 +++-- lisp/net/tramp.el | 88 ++++++++++++++++++++++++++++++++---------- lisp/net/trampver.el | 2 +- man/ChangeLog | 7 ++++ man/tramp.texi | 32 ++++++++++++++- man/trampver.texi | 2 +- 9 files changed, 233 insertions(+), 78 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1def811c5c5..d3ee155e0fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,49 @@ +2005-01-16 Michael Albinus + + Sync with Tramp 2.0.47. + + * tramp.el (tramp-operation-not-permitted-regexp) New defcustom, + catching keep-date problems in cp/scp operations. + (tramp-handle-copy-file): Don't call `set-file-modes' + unconditionally. Specialized functions should know better what is + necessary. This improves performance a little bit, and the + functions could catch errors with `cp -p' and `scp -p'. + (tramp-do-copy-or-rename-file-via-buffer) + (tramp-do-copy-or-rename-file-out-of-band): Call `set-file-modes' + when appropriate. + (tramp-do-copy-or-rename-file-directly): Mask `cp -p' error. Call + `set-file-modes' when appropriate. + (tramp-action-out-of-band): Mask `scp -p' error. Reported by Isak + Johnsson + (tramp-get-buffer, tramp-get-debug-buffer): Discard the undo list + of both Tramp buffer and debug buffer. Reported by Joakim Verona + + (tramp-file-name-for-operation): Mark `shell-command' as magic for + Emacs only. + + * tramp-util.el (tramp-minor-mode): New minor mode. Add it to + `find-file-hooks' and `dired-mode-hook'. + (tramp-minor-mode-map): Respective map. Add remapping for + `compile' and `recompile'. + (tramp-remap-command, tramp-recompile): New defuns. + (tramp-compile): Enable `tramp-minor-mode' and `compilation-mode' + in buffer "*Compilation*". Call the commands asynchronously. + + * tramp-vc.el (tramp-vc-do-command, tramp-vc-do-command-new) + (tramp-vc-simple-command): Call `tramp-handle-shell-command' but + `shell-command', because it isn't magic in XEmacs. Reported by + Adrian Aichner . + + * tramp-smb.el (tramp-smb-file-name-handler-alist): Add entry for + `substitute-in-file-name. + (tramp-smb-handle-substitute-in-file-name): New defun. + (tramp-smb-advice-PC-do-completion): Delete advice. + +2005-01-16 Kai Grossjohann + + * tramp.el (tramp-wait-for-output): Fix typo in echo processing. + Fix error in deleting region. + 2005-01-15 Richard M. Stallman * emacs-lisp/lisp-mnt.el (lm-with-file): Use Lisp mode in temp buffer. 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 +;; 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" diff --git a/man/ChangeLog b/man/ChangeLog index 0f4646e0d73..546589a509b 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,10 @@ +2005-01-16 Michael Albinus + + Sync with Tramp 2.0.47. + + * tramp.texi (Compilation): New section, describing compilation of + remote files. + 2005-01-15 Sergey Poznyakoff * man/rmail.texi: Document support for GNU mailutils in rmail.el. diff --git a/man/tramp.texi b/man/tramp.texi index e8577af4982..ac6fb4d5436 100644 --- a/man/tramp.texi +++ b/man/tramp.texi @@ -25,8 +25,8 @@ @end macro @copying -Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004 Free Software -Foundation, Inc. +Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free +Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -192,6 +192,7 @@ Using @value{tramp} * Multi-hop filename syntax:: Multi-hop filename conventions. * Filename completion:: Filename completion. * Dired:: Dired. +* Compilation:: Compile remote files. The inner workings of remote version control @@ -1690,6 +1691,7 @@ minute you have already forgotten that you hit that key! * Multi-hop filename syntax:: Multi-hop filename conventions. * Filename completion:: Filename completion. * Dired:: Dired. +* Compilation:: Compile remote files. @end menu @@ -1885,6 +1887,32 @@ present, than filename completion. Dired has its own cache mechanism and will only fetch the directory listing once. +@node Compilation +@section Compile remote files +@cindex compile +@cindex recompile + +@value{tramp} provides commands for compilation of files on remote +machines. In order to get them loaded, you need to require +@file{tramp-util.el}: + +@lisp +(require 'tramp-util) +@end lisp + +Afterwards, you can use the commands @code{tramp-compile} and +@code{tramp-recompile} instead of @code{compile} and @code{recompile}, +respectively; @inforef{Compilation, ,@value{emacsdir}}. This does not +work for the @option{ftp} and @option{smb} methods. + +The corresponding key bindings and menu entries calling these commands +are redefined automatically for buffers associated with remote files. + +After finishing the compilation, you can use the usual commands like +@code{previous-error}, @code{next-error} and @code{first-error} for +navigation in the @file{*Compilation*} buffer. + + @node Bug Reports @chapter Reporting Bugs and Problems @cindex bug reports diff --git a/man/trampver.texi b/man/trampver.texi index 45cbefb72ac..87b1dc8ebd1 100644 --- a/man/trampver.texi +++ b/man/trampver.texi @@ -4,7 +4,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.0.46 +@set trampver 2.0.47 @c Other flags from configuration @set prefix /usr/local -- 2.39.5