summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2004-06-28 07:56:49 +0000
committerMiles Bader <miles@gnu.org>2004-06-28 07:56:49 +0000
commit327719ee8a3fcdb36ed6acaf6d8cb5fbdf0bd801 (patch)
tree21de188e13b5e41a79bb50040933072ae0235217 /lisp/net
parent852f73b7fa7b71910282eacb6263b3ecfd4ee783 (diff)
parent376de73927383d6062483db10b8a82448505f52b (diff)
downloademacs-327719ee8a3fcdb36ed6acaf6d8cb5fbdf0bd801.tar.gz
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/ange-ftp.el7
-rw-r--r--lisp/net/browse-url.el31
-rw-r--r--lisp/net/ldap.el2
-rw-r--r--lisp/net/quickurl.el16
-rw-r--r--lisp/net/telnet.el37
-rw-r--r--lisp/net/tramp-smb.el18
-rw-r--r--lisp/net/tramp-uu.el10
-rw-r--r--lisp/net/tramp-vc.el41
-rw-r--r--lisp/net/tramp.el481
9 files changed, 449 insertions, 194 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 8e1068a5bed..09448e87329 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4116,6 +4116,9 @@ directory, so that Emacs will know its current contents."
(format "Getting %s" fn1))
tmp1))))
+(defun ange-ftp-file-remote-p (file)
+ (when (ange-ftp-ftp-name file) t))
+
(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
(if (ange-ftp-ftp-name file)
(let ((tryfiles (if nosuffix
@@ -4257,9 +4260,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(let ((fn (get operation 'ange-ftp)))
(if fn (save-match-data (apply fn args))
(ange-ftp-run-real-handler operation args))))
-;;;###autoload
-;;; These file names are remote file names.
-(put 'ange-ftp-hook-function 'file-remote-p t)
;; The following code is commented out because Tramp now deals with
;; Ange-FTP filenames, too.
@@ -4327,6 +4327,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
(put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
(put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
+(put 'file-remote-p 'ange-ftp 'ange-ftp-file-remote-p)
(put 'unhandled-file-name-directory 'ange-ftp
'ange-ftp-unhandled-file-name-directory)
(put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index a70e08028d2..1dbd97f0073 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -577,13 +577,22 @@ down (this *won't* always work)."
(defun browse-url-interactive-arg (prompt)
"Read a URL from the minibuffer, prompting with PROMPT.
-Default to the URL at or before point. If invoked with a mouse button,
-set point to the position clicked first. Return a list for use in
-`interactive' containing the URL and `browse-url-new-window-flag' or its
-negation if a prefix argument was given."
+If `transient-mark-mode' is non-nil and the mark is active,
+it defaults to the current region, else to the URL at or before
+point. If invoked with a mouse button, it moves point to the
+position clicked before acting.
+
+This function returns a list (URL NEW-WINDOW-FLAG)
+for use in `interactive'."
(let ((event (elt (this-command-keys) 0)))
(and (listp event) (mouse-set-point event)))
- (list (read-string prompt (browse-url-url-at-point))
+ (list (read-string prompt (or (and transient-mark-mode mark-active
+ ;; rfc2396 Appendix E.
+ (replace-regexp-in-string
+ "[\t\r\f\n ]+" ""
+ (buffer-substring-no-properties
+ (region-beginning) (region-end))))
+ (browse-url-url-at-point)))
(not (eq (null browse-url-new-window-flag)
(null current-prefix-arg)))))
@@ -847,7 +856,7 @@ used instead of `browse-url-new-window-flag'."
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
- (message "Starting Netscape...")
+ (message "Starting %s..." browse-url-netscape-program)
(apply 'start-process (concat "netscape" url) nil
browse-url-netscape-program
(append browse-url-netscape-startup-arguments (list url))))))
@@ -918,7 +927,7 @@ used instead of `browse-url-new-window-flag'."
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Mozilla is not running - start it
- (message "Starting Mozilla...")
+ (message "Starting %s..." browse-url-mozilla-program)
(apply 'start-process (concat "mozilla " url) nil
browse-url-mozilla-program
(append browse-url-mozilla-startup-arguments (list url))))))
@@ -968,7 +977,7 @@ used instead of `browse-url-new-window-flag'."
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
- (message "Starting Galeon...")
+ (message "Starting %s..." browse-url-galeon-program)
(apply 'start-process (concat "galeon " url) nil
browse-url-galeon-program
(append browse-url-galeon-startup-arguments (list url))))))
@@ -1017,7 +1026,7 @@ used instead of `browse-url-new-window-flag'."
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Epiphany is not running - start it
- (message "Starting Epiphany...")
+ (message "Starting %s..." browse-url-epiphany-program)
(apply 'start-process (concat "epiphany " url) nil
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
@@ -1098,10 +1107,10 @@ used instead of `browse-url-new-window-flag'."
(message "Signalling Mosaic...done")
)
;; Mosaic not running - start it
- (message "Starting Mosaic...")
+ (message "Starting %s..." browse-url-mosaic-program)
(apply 'start-process "xmosaic" nil browse-url-mosaic-program
(append browse-url-mosaic-arguments (list url)))
- (message "Starting Mosaic...done"))))
+ (message "Starting %s...done" browse-url-mosaic-program))))
;; --- Grail ---
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 55af47e6a87..f093fb1cbcc 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -554,7 +554,7 @@ an alist of attribute/value pairs."
(setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
(eval `(call-process ldap-ldapsearch-prog
nil
- buf
+ `(,buf nil)
nil
,@arglist
,@ldap-ldapsearch-args
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index fd13b3a0f51..40a1e4bfad3 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -256,14 +256,16 @@ returned."
;; Main code:
-(defun* quickurl-read (&optional (buffer (current-buffer)))
+(defun* quickurl-read (&optional buffer)
"`read' the URL list from BUFFER into `quickurl-urls'.
+BUFFER, if nil, defaults to current buffer.
Note that this function moves point to `point-min' before doing the `read'
It also restores point after the `read'."
(save-excursion
(setf (point) (point-min))
- (setq quickurl-urls (funcall quickurl-sort-function (read buffer)))))
+ (setq quickurl-urls (funcall quickurl-sort-function
+ (read (or buffer (current-buffer)))))))
(defun quickurl-load-urls ()
"Load the contents of `quickurl-url-file' into `quickurl-urls'."
@@ -298,14 +300,15 @@ Also display a `message' saying what the URL was unless SILENT is non-nil."
(message "Found %s" (quickurl-url-url url))))
;;;###autoload
-(defun* quickurl (&optional (lookup (funcall quickurl-grab-lookup-function)))
+(defun* quickurl (&optional lookup)
"Insert an URL based on LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the current
buffer, this default action can be modifed via
`quickurl-grab-lookup-function'."
(interactive)
- (when lookup
+ (when (or lookup
+ (setq lookup (funcall quickurl-grab-lookup-function)))
(quickurl-load-urls)
(let ((url (quickurl-find-url lookup)))
(if (null url)
@@ -392,14 +395,15 @@ is decided."
(message "Added %s" url))))))
;;;###autoload
-(defun* quickurl-browse-url (&optional (lookup (funcall quickurl-grab-lookup-function)))
+(defun quickurl-browse-url (&optional lookup)
"Browse the URL associated with LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the
current buffer, this default action can be modifed via
`quickurl-grab-lookup-function'."
(interactive)
- (when lookup
+ (when (or lookup
+ (setq lookup (funcall quickurl-grab-lookup-function)))
(quickurl-load-urls)
(let ((url (quickurl-find-url lookup)))
(if url
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index dac6f228cd6..40a28494774 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,6 +1,6 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer
-;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 88, 1992, 94, 2004 Free Software Foundation, Inc.
;; Author: William F. Schelter
;; Maintainer: FSF
@@ -197,18 +197,28 @@ rejecting one login and prompting again for a username and password.")
;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
;;;###autoload
-(defun telnet (host)
+(defun telnet (host &optional port)
"Open a network login connection to host named HOST (a string).
+Optional arg PORT specifies alternative port to connect to.
+Interactively, use \\[universal-argument] prefix to be prompted for port number.
+
Communication with HOST is recorded in a buffer `*PROGRAM-HOST*'
where PROGRAM is the telnet program being used. This program
is controlled by the contents of the global variable `telnet-host-properties',
falling back on the value of the global variable `telnet-program'.
Normally input is edited in Emacs and sent a line at a time."
- (interactive "sOpen connection to host: ")
+ (interactive (list (read-string "Open connection to host: ")
+ (cond
+ ((null current-prefix-arg) nil)
+ ((consp current-prefix-arg) (read-string "Port: "))
+ (t (prefix-numeric-value current-prefix-arg)))))
+ (if (and port (numberp port))
+ (setq port (int-to-string port)))
(let* ((comint-delimiter-argument-list '(?\ ?\t))
(properties (cdr (assoc host telnet-host-properties)))
(telnet-program (if properties (car properties) telnet-program))
- (name (concat telnet-program "-" (comint-arguments host 0 nil) ))
+ (hname (if port (concat host ":" port) host))
+ (name (concat telnet-program "-" (comint-arguments hname 0 nil) ))
(buffer (get-buffer (concat "*" name "*")))
(telnet-options (if (cdr properties) (cons "-l" (cdr properties))))
process)
@@ -221,29 +231,22 @@ Normally input is edited in Emacs and sent a line at a time."
;; Don't send the `open' cmd till telnet is ready for it.
(accept-process-output process)
(erase-buffer)
- (send-string process (concat "open " host "\n"))
+ (send-string process (concat "open " host
+ (if port " " "") (or port "")
+ "\n"))
(telnet-mode)
(setq comint-input-sender 'telnet-simple-send)
(setq telnet-count telnet-initial-count))))
(put 'telnet-mode 'mode-class 'special)
-(defun telnet-mode ()
+(define-derived-mode telnet-mode comint-mode "Telnet"
"This mode is for using telnet (or rsh) from a buffer to another host.
It has most of the same commands as comint-mode.
There is a variable ``telnet-interrupt-string'' which is the character
sent to try to stop execution of a job on the remote host.
-Data is sent to the remote host when RET is typed.
-
-\\{telnet-mode-map}
-"
- (interactive)
- (comint-mode)
- (setq major-mode 'telnet-mode
- mode-name "Telnet"
- comint-prompt-regexp telnet-prompt-pattern)
- (use-local-map telnet-mode-map)
- (run-hooks 'telnet-mode-hook))
+Data is sent to the remote host when RET is typed."
+ (set (make-local-variable 'comint-prompt-regexp) telnet-prompt-pattern))
;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index ab6ad3310c1..cca01d169b6 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -38,6 +38,19 @@
(or (>= emacs-major-version 20)
(load "cl-seq")))
+;; Avoid byte-compiler warnings if the byte-compiler supports this.
+;; Currently, XEmacs supports this.
+(eval-when-compile
+ (when (fboundp 'byte-compiler-options)
+ (let (unused-vars) ; Pacify Emacs byte-compiler
+ (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
+ (byte-compiler-options (warnings (- unused-vars))))))
+
+;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'.
+(eval-when-compile
+ (unless (boundp 'last-coding-system-used)
+ (defvar last-coding-system-used nil)))
+
;; Define SMB method ...
(defcustom tramp-smb-method "smb"
"*Method to connect SAMBA and M$ SMB servers."
@@ -131,6 +144,7 @@ This variable is local to each buffer.")
(file-executable-p . tramp-smb-handle-file-exists-p)
(file-exists-p . tramp-smb-handle-file-exists-p)
(file-local-copy . tramp-smb-handle-file-local-copy)
+ (file-remote-p . tramp-handle-file-remote-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler
@@ -145,7 +159,7 @@ This variable is local to each buffer.")
(file-symlink-p . tramp-smb-not-handled)
;; `file-truename' performed by default handler
(file-writable-p . tramp-smb-handle-file-writable-p)
- ;; `find-backup-file-name' performed by default handler
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler
;; `get-file-buffer' performed by default handler
(insert-directory . tramp-smb-handle-insert-directory)
@@ -990,7 +1004,7 @@ Domain names in USER and port numbers in HOST are acknowledged."
tramp-smb-program args)))
(tramp-message 9 "Started process %s" (process-command p))
- (process-kill-without-query p)
+ (tramp-set-process-query-on-exit-flag p nil)
(set-buffer buffer)
(setq tramp-smb-share share)
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 1047e62a3cb..d18af101c48 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -1,7 +1,7 @@
;;; -*- coding: iso-2022-7bit; -*-
;;; tramp-uu.el --- uuencode in Lisp
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
;; Author: Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Keywords: comm, terminals
@@ -63,10 +63,10 @@
(setq c (char-after (point)))
(delete-char 1)
(if (equal c ?=)
- ;; "=" means padding. Insert "`" instead.
- (insert "`")
- (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c))))
- (setq i (1+ i))
+ ;; "=" means padding. Insert "`" instead. Not counted for length.
+ (progn (insert "`") (setq len (1- len)))
+ (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c)))
+ (setq i (1+ i)))
;; Every 60 characters, add "M" at beginning of line (as
;; length byte) and insert a newline.
(when (zerop (% i 60))
diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el
index ded30f4b09c..839a8702dd9 100644
--- a/lisp/net/tramp-vc.el
+++ b/lisp/net/tramp-vc.el
@@ -1,6 +1,6 @@
;;; tramp-vc.el --- Version control integration for TRAMP.el
-;; Copyright (C) 2000 by Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004 by Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@danann.net>
;; Keywords: comm, processes
@@ -38,6 +38,14 @@
(require 'vc-rcs))
(require 'tramp)
+;; Avoid byte-compiler warnings if the byte-compiler supports this.
+;; Currently, XEmacs supports this.
+(eval-when-compile
+ (when (fboundp 'byte-compiler-options)
+ (let (unused-vars) ; Pacify Emacs byte-compiler
+ (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
+ (byte-compiler-options (warnings (- unused-vars))))))
+
;; -- vc --
;; This used to blow away the file-name-handler-alist and reinstall
@@ -163,7 +171,9 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(if vc-command-messages
(message "Running %s on %s..." command file))
(save-current-buffer
- (unless (eq buffer t) (vc-setup-buffer buffer))
+ (unless (eq buffer t)
+ ; Pacify byte-compiler
+ (funcall (symbol-function 'vc-setup-buffer) buffer))
(let ((squeezed nil)
(inhibit-read-only t)
(status 0))
@@ -192,9 +202,10 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(if (integerp status) (format "status %d" status) status))))
(if vc-command-messages
(message "Running %s...OK" command))
- (vc-exec-after
- `(run-hook-with-args
- 'vc-post-command-functions ',command ',localname ',flags))
+ ; Pacify byte-compiler
+ (funcall (symbol-function 'vc-exec-after)
+ `(run-hook-with-args
+ 'vc-post-command-functions ',command ',localname ',flags))
status))))
@@ -325,7 +336,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(not want-differences-if-changed))))
(zerop status))
;; New VC. Call `vc-default-workfile-unchanged-p'.
- (vc-default-workfile-unchanged-p (vc-backend file) filename)))
+ (funcall (symbol-function 'vc-default-workfile-unchanged-p)
+ (vc-backend filename) filename)))
(defadvice vc-workfile-unchanged-p
(around tramp-advice-vc-workfile-unchanged-p
@@ -391,14 +403,15 @@ filename we are thinking about..."
;; Pacify byte-compiler; this symbol is bound in the calling
;; function. CCC: Maybe it would be better to move the
;; boundness-checking into this function?
- (let ((file (symbol-value 'file))
- (remote-uid
- ;; With Emacs 21.4, `file-attributes' has got an optional parameter
- ;; ID-FORMAT. Handle this case backwards compatible.
- (if (and (functionp 'subr-arity)
- (= 2 (cdr (subr-arity (symbol-function 'file-attributes)))))
- (nth 2 (file-attributes file 'integer))
- (nth 2 (file-attributes file)))))
+ (let* ((file (symbol-value 'file))
+ (remote-uid
+ ;; With Emacs 21.4, `file-attributes' has got an optional parameter
+ ;; ID-FORMAT. Handle this case backwards compatible.
+ (if (and (functionp 'subr-arity)
+ (= 2 (cdr (funcall (symbol-function 'subr-arity)
+ (symbol-function 'file-attributes)))))
+ (nth 2 (file-attributes file 'integer))
+ (nth 2 (file-attributes file)))))
(if (and uid (/= uid remote-uid))
(error "tramp-handle-vc-user-login-name cannot map a uid to a name")
(let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cd6ed337927..769ad3f51f6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -135,11 +135,25 @@ Nil means to use a separate filename syntax for Tramp.")
(unless (boundp 'custom-print-functions)
(defvar custom-print-functions nil)) ; not autoloaded before Emacs 20.4
-;; Avoid bytecompiler warnings if the byte-compiler supports this.
+;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
(when (fboundp 'byte-compiler-options)
- (byte-compiler-options (warnings (- unused-vars)))))
+ (let (unused-vars) ; Pacify Emacs byte-compiler
+ (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
+ (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
+ (when (boundp 'byte-compile-not-obsolete-var)
+ (setq byte-compile-not-obsolete-var 'directory-sep-char)))
+
+;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'.
+(eval-when-compile
+ (unless (boundp 'last-coding-system-used)
+ (defvar last-coding-system-used nil)))
;;; User Customizable Internal Variables:
@@ -157,6 +171,49 @@ Nil means to use a separate filename syntax for Tramp.")
:group 'tramp
:type 'boolean)
+;; Emacs case
+(eval-and-compile
+ (when (boundp 'backup-directory-alist)
+ (defcustom tramp-backup-directory-alist nil
+ "Alist of filename patterns and backup directory names.
+Each element looks like (REGEXP . DIRECTORY), with the same meaning like
+in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
+is a local file name, the backup directory is prepended with Tramp file
+name prefix \(multi-method, method, user, host\) of file.
+
+\(setq tramp-backup-directory-alist backup-directory-alist\)
+
+gives the same backup policy for Tramp files on their hosts like the
+policy for local files."
+ :group 'tramp
+ :type '(repeat (cons (regexp :tag "Regexp matching filename")
+ (directory :tag "Backup directory name"))))))
+
+;; XEmacs case. We cannot check for `bkup-backup-directory-info', because
+;; the package "backup-dir" might not be loaded yet.
+(eval-and-compile
+ (when (featurep 'xemacs)
+ (defcustom tramp-bkup-backup-directory-info nil
+ "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
+It has the same meaning like `bkup-backup-directory-info' from package
+`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
+file name, the backup directory is prepended with Tramp file name prefix
+\(multi-method, method, user, host\) of file.
+
+\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
+
+gives the same backup policy for Tramp files on their hosts like the
+policy for local files."
+ :type '(repeat
+ (list (regexp :tag "File regexp")
+ (string :tag "Backup Dir")
+ (set :inline t
+ (const ok-create)
+ (const full-path)
+ (const prepend-name)
+ (const search-upward))))
+ :group 'tramp)))
+
(defcustom tramp-auto-save-directory nil
"*Put auto-save files in this directory, if set.
The idea is to use a local directory so that auto-saving is faster."
@@ -854,6 +911,16 @@ The answer will be provided by `tramp-action-terminal', which see."
:group 'tramp
:type 'regexp)
+(defcustom tramp-process-alive-regexp
+ ""
+ "Regular expression indicating a process has finished.
+In fact this expression is empty by intention, it will be used only to
+check regularly the status of the associated process.
+The answer will be provided by `tramp-action-process-alive' and
+`tramp-action-out-of-band', which see."
+ :group 'tramp
+ :type 'regexp)
+
(defcustom tramp-temp-name-prefix "tramp."
"*Prefix to use for temporary files.
If this is a relative file name (such as \"tramp.\"), it is considered
@@ -1080,7 +1147,7 @@ Also see `tramp-file-name-structure'."
;;;###autoload
(defconst tramp-completion-file-name-regexp-unified
- "^/[^/]*$"
+ "^/$\\|^/[^/:][^/]*$"
"Value for `tramp-completion-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure-unified' for more explanations.")
@@ -1222,7 +1289,8 @@ but it might be slow on large directories."
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-yesno-prompt-regexp tramp-action-yesno)
(tramp-yn-prompt-regexp tramp-action-yn)
- (tramp-terminal-prompt-regexp tramp-action-terminal))
+ (tramp-terminal-prompt-regexp tramp-action-terminal)
+ (tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
Each item looks like (PATTERN ACTION).
@@ -1237,12 +1305,23 @@ corresponding PATTERN matches, the ACTION function is called."
:group 'tramp
:type '(repeat (list variable function)))
+(defcustom tramp-actions-copy-out-of-band
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-action-out-of-band))
+ "List of pattern/action pairs.
+This list is used for copying/renaming with out-of-band methods.
+See `tramp-actions-before-shell' for more info."
+ :group 'tramp
+ :type '(repeat (list variable function)))
+
(defcustom tramp-multi-actions
'((tramp-password-prompt-regexp tramp-multi-action-password)
(tramp-login-prompt-regexp tramp-multi-action-login)
(shell-prompt-pattern tramp-multi-action-succeed)
(tramp-shell-prompt-pattern tramp-multi-action-succeed)
- (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied))
+ (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
+ (tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
This list is used for each hop in multi-hop connections.
See `tramp-actions-before-shell' for more info."
@@ -1250,7 +1329,8 @@ See `tramp-actions-before-shell' for more info."
:type '(repeat (list variable function)))
(defcustom tramp-initial-commands
- '("unset correct"
+ '("unset HISTORY"
+ "unset correct"
"unset autocorrect")
"List of commands to send to the first remote shell that we see.
These commands will be sent to any shell, and thus they should be
@@ -1326,7 +1406,8 @@ the visited file modtime.")
(defvar tramp-md5-function
(cond ((and (require 'md5) (fboundp 'md5)) 'md5)
((fboundp 'md5-encode)
- (lambda (x) (base64-encode-string (md5-encode x))))
+ (lambda (x) (base64-encode-string
+ (funcall (symbol-function 'md5-encode) x))))
(t (error "Coulnd't find an `md5' function")))
"Function to call for running the MD5 algorithm.")
@@ -1464,7 +1545,7 @@ some systems don't, and for them we have this shell function.")
;; The device number is returned as "-1", because there will be a virtual
;; device number set in `tramp-handle-file-attributes'
(defconst tramp-perl-file-attributes "\
-($f, $n) = @ARGV;
+\($f, $n) = @ARGV;
@s = lstat($f);
if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; }
elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; }
@@ -1628,6 +1709,14 @@ This is used to map a mode number to a permission string.")
'undecided-dos)
"Some Emacsen know the `dos' coding system, others need `undecided-dos'.")
+(defvar tramp-last-cmd nil
+ "Internal Tramp variable recording the last command sent.
+This variable is buffer-local in every buffer.")
+(make-variable-buffer-local 'tramp-last-cmd)
+
+(defvar tramp-process-echoes nil
+ "Whether to process echoes from the remote shell.")
+
(defvar tramp-last-cmd-time nil
"Internal Tramp variable recording the time when the last cmd was sent.
This variable is buffer-local in every buffer.")
@@ -1638,7 +1727,8 @@ This variable is buffer-local in every buffer.")
(defvar tramp-feature-write-region-fix
(when (fboundp 'find-operation-coding-system)
(let ((file-coding-system-alist '(("test" emacs-mule))))
- (find-operation-coding-system 'write-region 0 0 "" nil "test")))
+ (funcall (symbol-function 'find-operation-coding-system)
+ 'write-region 0 0 "" nil "test")))
"Internal variable to say if `write-region' chooses the right coding.
Older versions of Emacs chose the coding system for `write-region' based
on the FILENAME argument, even if VISIT was a string.")
@@ -1682,8 +1772,10 @@ on the FILENAME argument, even if VISIT was a string.")
(insert-directory . tramp-handle-insert-directory)
(expand-file-name . tramp-handle-expand-file-name)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-remote-p . tramp-handle-file-remote-p)
(insert-file-contents . tramp-handle-insert-file-contents)
(write-region . tramp-handle-write-region)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(dired-compress-file . tramp-handle-dired-compress-file)
(dired-call-process . tramp-handle-dired-call-process)
@@ -1756,8 +1848,8 @@ remaining args passed to `tramp-message'."
Calls `line-end-position' or `point-at-eol' if defined, else
own implementation."
(cond
- ((fboundp 'line-end-position) (funcall 'line-end-position))
- ((fboundp 'point-at-eol) (funcall 'point-at-eol))
+ ((fboundp 'line-end-position) (funcall (symbol-function 'line-end-position)))
+ ((fboundp 'point-at-eol) (funcall (symbol-function 'point-at-eol)))
(t (save-excursion (end-of-line) (point)))))
(defmacro with-parsed-tramp-file-name (filename var &rest body)
@@ -1790,6 +1882,18 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
,@body))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
+;; To be activated for debugging containing this macro
+(def-edebug-spec with-parsed-tramp-file-name t)
+
+(defmacro tramp-let-maybe (variable value &rest body)
+ "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
+BODY is executed whether or not the variable is obsolete.
+The intent is to protect against `obsolete variable' warnings."
+ `(if (get ',variable 'byte-obsolete-variable)
+ (progn ,@body)
+ (let ((,variable ,value))
+ ,@body)))
+(put 'tramp-let-maybe 'lisp-indent-function 2)
;;; Config Manipulation Functions:
@@ -1953,8 +2057,8 @@ target of the symlink differ."
"Like `file-truename' for tramp files."
(with-parsed-tramp-file-name filename nil
(let* ((steps (tramp-split-string localname "/"))
- (localnamedir (let ((directory-sep-char ?/))
- (file-name-as-directory localname)))
+ (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
+ (file-name-as-directory localname)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
@@ -2711,7 +2815,7 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
;; matter which filename handlers are used for the
;; source and target file.
(t
- (tramp-do-copy-or-rename-via-buffer
+ (tramp-do-copy-or-rename-file-via-buffer
op filename newname keep-date))))
;; One file is a Tramp file, the other one is local.
@@ -2727,14 +2831,14 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date)
;; Use the generic method via a Tramp buffer.
- (tramp-do-copy-or-rename-via-buffer op filename newname keep-date)))
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date)))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))))
-;; CCC: implement keep-date if possible -- via touch?
-(defun tramp-do-copy-or-rename-via-buffer (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
@@ -2754,10 +2858,11 @@ 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 (and keep-date
- (not (null modtime))
- (not (equal modtime '(0 0))))
- (tramp-touch newname modtime)))
+ (when keep-date
+ (when (and (not (null modtime))
+ (not (equal modtime '(0 0))))
+ (tramp-touch newname modtime))
+ (set-file-modes newname (file-modes filename))))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
(delete-file filename))))
@@ -2791,12 +2896,12 @@ If KEEP-DATE is non-nil, preserve the time stamp when copying."
"Invoke rcp program to copy.
One of FILENAME and NEWNAME must be a Tramp name, the other must
be a local filename. The method used must be an out-of-band method."
- (let ((trampbuf (get-buffer-create "*tramp output*"))
- (t1 (tramp-tramp-file-p filename))
+ (let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
v1-multi-method v1-method v1-user v1-host v1-localname
v2-multi-method v2-method v2-user v2-host v2-localname
- method copy-program copy-args source target)
+ multi-method method user host copy-program copy-args
+ source target trampbuf)
;; Check which ones of source and target are Tramp files.
;; We cannot invoke `with-parsed-tramp-file-name';
@@ -2808,8 +2913,11 @@ be a local filename. The method used must be an out-of-band method."
v1-user l-user
v1-host l-host
v1-localname l-localname
+ multi-method l-multi-method
method (tramp-find-method
v1-multi-method v1-method v1-user v1-host)
+ user l-user
+ host l-host
copy-program (tramp-get-method-parameter
v1-multi-method method
v1-user v1-host 'tramp-copy-program)
@@ -2825,8 +2933,11 @@ be a local filename. The method used must be an out-of-band method."
v2-user l-user
v2-host l-host
v2-localname l-localname
+ multi-method l-multi-method
method (tramp-find-method
v2-multi-method v2-method v2-user v2-host)
+ user l-user
+ host l-host
copy-program (tramp-get-method-parameter
v2-multi-method method
v2-user v2-host 'tramp-copy-program)
@@ -2871,24 +2982,29 @@ be a local filename. The method used must be an out-of-band method."
v2-user v2-host 'tramp-copy-keep-date-arg)
copy-args))))
- (setq copy-args (append copy-args (list source target)))
+ (setq copy-args (append copy-args (list source target))
+ trampbuf (generate-new-buffer
+ (tramp-buffer-name multi-method method user host)))
- ;; Use rcp-like program for file transfer.
- (tramp-message
- 5 "Transferring %s to file %s..." filename newname)
- (save-excursion (set-buffer trampbuf) (erase-buffer))
- (unless (equal
- 0
- (apply #'call-process copy-program
- nil trampbuf nil copy-args))
- (pop-to-buffer trampbuf)
- (error
- (concat
- "tramp-do-copy-or-rename-file-out-of-band: `%s' didn't work, "
- "see buffer `%s' for details")
- copy-program trampbuf))
- (tramp-message
- 5 "Transferring %s to file %s...done" filename newname)
+ ;; Use an asynchronous process. By this, password can be handled.
+ (save-excursion
+ (set-buffer trampbuf)
+ (setq tramp-current-multi-method multi-method
+ tramp-current-method method
+ tramp-current-user user
+ tramp-current-host host)
+ (tramp-message
+ 5 "Transferring %s to file %s..." filename newname)
+
+ ;; Use rcp-like program for file transfer.
+ (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf
+ copy-program copy-args)))
+ (tramp-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p multi-method method user host
+ tramp-actions-copy-out-of-band))
+ (kill-buffer trampbuf)
+ (tramp-message
+ 5 "Transferring %s to file %s...done" filename newname))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
@@ -3012,7 +3128,8 @@ This is like `dired-recursive-delete-directory' for tramp files."
multi-method method user host
(concat (nth 2 suffix) " " localname)))
(message "Uncompressing %s...done" file)
- (dired-remove-file file)
+ ;; `dired-remove-file' is not defined in XEmacs
+ (funcall (symbol-function 'dired-remove-file) file)
(string-match (car suffix) file)
(concat (substring file 0 (match-beginning 0)))))
(t
@@ -3023,7 +3140,8 @@ This is like `dired-recursive-delete-directory' for tramp files."
multi-method method user host
(concat "gzip -f " localname)))
(message "Compressing %s...done" file)
- (dired-remove-file file)
+ ;; `dired-remove-file' is not defined in XEmacs
+ (funcall (symbol-function 'dired-remove-file) file)
(cond ((file-exists-p (concat file ".gz"))
(concat file ".gz"))
((file-exists-p (concat file ".z"))
@@ -3091,12 +3209,10 @@ This is like `dired-recursive-delete-directory' for tramp files."
(format "%s %s %s"
(tramp-get-ls-command multi-method method user host)
switches
- (if full-directory-p
- ;; Add "/." to make sure we got complete dir
- ;; listing for symlinks, too.
- (concat (file-name-as-directory
- (file-name-nondirectory localname)) ".")
- (file-name-nondirectory localname)))))
+ (if wildcard
+ localname
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname))))))
(sit-for 1) ;needed for rsh but not ssh?
(tramp-wait-for-output))
;; The following let-binding is used by code that's commented
@@ -3196,7 +3312,7 @@ the result will be a local, non-Tramp, filename."
;; expand-file-name (this does "/./" and "/../"). We bind
;; directory-sep-char here for XEmacs on Windows, which
;; would otherwise use backslash.
- (let ((directory-sep-char ?/))
+ (tramp-let-maybe directory-sep-char ?/
(tramp-make-tramp-file-name
multi-method (or method (tramp-find-default-method user host))
user host
@@ -3361,7 +3477,6 @@ This will break if COMMAND prints a newline, followed by the value of
filename))
(setq tmpfil (tramp-make-temp-file))
-
(cond ((tramp-method-out-of-band-p multi-method method user host)
;; `copy-file' handles out-of-band methods
(copy-file filename tmpfil t t))
@@ -3418,11 +3533,16 @@ This will break if COMMAND prints a newline, followed by the value of
(delete-file tmpfil2)))
(tramp-message-for-buffer
multi-method method user host
- 5 "Decoding remote file %s...done" filename)))
+ 5 "Decoding remote file %s...done" filename)
+ ;; Set proper permissions.
+ (set-file-modes tmpfil (file-modes filename))))
(t (error "Wrong method specification for `%s'" method)))
tmpfil)))
+(defun tramp-handle-file-remote-p (filename)
+ "Like `file-remote-p' for tramp files."
+ (when (tramp-tramp-file-p filename) t))
(defun tramp-handle-insert-file-contents
(filename &optional visit beg end replace)
@@ -3470,6 +3590,49 @@ This will break if COMMAND prints a newline, followed by the value of
(list (expand-file-name filename)
(second result))))))
+
+(defun tramp-handle-find-backup-file-name (filename)
+ "Like `find-backup-file-name' for tramp files."
+
+ (if (or (and (not (featurep 'xemacs))
+ (not (boundp 'tramp-backup-directory-alist)))
+ (and (featurep 'xemacs)
+ (not (boundp 'tramp-bkup-backup-directory-info))))
+
+ ;; No tramp backup directory alist defined, or nil
+ (tramp-run-real-handler 'find-backup-file-name (list filename))
+
+ (with-parsed-tramp-file-name filename nil
+ (let* ((backup-var
+ (copy-tree
+ (if (featurep 'xemacs)
+ ;; XEmacs case
+ (symbol-value 'tramp-bkup-backup-directory-info)
+ ;; Emacs case
+ (symbol-value 'tramp-backup-directory-alist))))
+
+ ;; We set both variables. It doesn't matter whether it is
+ ;; Emacs or XEmacs
+ (backup-directory-alist backup-var)
+ (bkup-backup-directory-info backup-var))
+
+ (mapcar
+ '(lambda (x)
+ (let ((dir (if (consp (cdr x)) (car (cdr x)) (cdr x))))
+ (when (and (stringp dir)
+ (file-name-absolute-p dir)
+ (not (tramp-file-name-p dir)))
+ ;; Prepend absolute directory names with tramp prefix
+ (if (consp (cdr x))
+ (setcar (cdr x)
+ (tramp-make-tramp-file-name
+ multi-method method user host dir))
+ (setcdr x (tramp-make-tramp-file-name
+ multi-method method user host dir))))))
+ backup-var)
+
+ (tramp-run-real-handler 'find-backup-file-name (list filename))))))
+
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
(start end filename &optional append visit lockname confirm)
@@ -3499,6 +3662,7 @@ This will break if COMMAND prints a newline, followed by the value of
(loc-enc (tramp-get-local-encoding multi-method method user host))
(loc-dec (tramp-get-local-decoding multi-method method user host))
(trampbuf (get-buffer-create "*tramp output*"))
+ (modes (file-modes filename))
;; We use this to save the value of `last-coding-system-used'
;; after writing the tmp file. At the end of the function,
;; we set `last-coding-system-used' to this saved value.
@@ -3519,6 +3683,11 @@ This will break if COMMAND prints a newline, followed by the value of
(if confirm ; don't pass this arg unless defined for backward compat.
(list start end tmpfil append 'no-message lockname confirm)
(list start end tmpfil append 'no-message lockname)))
+ ;; The permissions of the temporary file should be set. If
+ ;; filename does not exist (eq modes nil) it has been renamed to
+ ;; the backup file. This case `save-buffer' handles
+ ;; permissions.
+ (when modes (set-file-modes tmpfil modes))
;; Now, `last-coding-system-used' has the right value. Remember it.
(when (boundp 'last-coding-system-used)
(setq coding-system-used last-coding-system-used))
@@ -3694,10 +3863,10 @@ pass to the OPERATION."
;; We handle here all file primitives. Most of them have the file
;; name as first parameter; nevertheless we check for them explicitly
-;; in order to be be signalled if a new primitive appears. This
+;; in order to be signalled if a new primitive appears. This
;; scenario is needed because there isn't a way to decide by
;; syntactical means whether a foreign method must be called. It would
-;; ease the live if `file-name-handler-alist' would support a decision
+;; ease the life if `file-name-handler-alist' would support a decision
;; function as well but regexp only.
(defun tramp-file-name-for-operation (operation &rest args)
"Return file name related to OPERATION file primitive.
@@ -3711,16 +3880,16 @@ ARGS are the arguments OPERATION has been called with."
'dired-compress-file 'dired-uncache
'file-accessible-directory-p 'file-attributes
'file-directory-p 'file-executable-p 'file-exists-p
- 'file-local-copy 'file-modes 'file-name-as-directory
- 'file-name-directory 'file-name-nondirectory
- 'file-name-sans-versions 'file-ownership-preserved-p
- 'file-readable-p 'file-regular-p 'file-symlink-p
- 'file-truename 'file-writable-p 'find-backup-file-name
- 'find-file-noselect 'get-file-buffer 'insert-directory
- 'insert-file-contents 'load 'make-directory
- 'make-directory-internal 'set-file-modes
- 'substitute-in-file-name 'unhandled-file-name-directory
- 'vc-registered
+ 'file-local-copy 'file-remote-p 'file-modes
+ 'file-name-as-directory 'file-name-directory
+ 'file-name-nondirectory 'file-name-sans-versions
+ 'file-ownership-preserved-p 'file-readable-p
+ 'file-regular-p 'file-symlink-p 'file-truename
+ 'file-writable-p 'find-backup-file-name 'find-file-noselect
+ 'get-file-buffer 'insert-directory 'insert-file-contents
+ 'load 'make-directory 'make-directory-internal
+ 'set-file-modes 'substitute-in-file-name
+ 'unhandled-file-name-directory 'vc-registered
; XEmacs only
'abbreviate-file-name 'create-file-buffer
'dired-file-modtime 'dired-make-compressed-filename
@@ -3789,9 +3958,6 @@ Falls back to normal file name handler if no tramp file name handler exists."
(foreign (apply foreign operation args))
(t (tramp-run-real-handler operation args))))))
-;;;###autoload
-(put 'tramp-file-name-handler 'file-remote-p t) ;for file-remote-p
-
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
@@ -3885,7 +4051,7 @@ necessary anymore."
(list (tramp-handle-expand-file-name name))))))
;; Check for complete.el and override PC-expand-many-files if appropriate.
-(eval-when-compile
+(eval-and-compile
(defun tramp-save-PC-expand-many-files (name))); avoid compiler warning
(defun tramp-setup-complete ()
@@ -3936,11 +4102,14 @@ necessary anymore."
(and (featurep 'xemacs)
(not (event-modifiers last-input-event))
(or (char-equal
- (funcall 'event-to-character last-input-event) ?\?)
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\?)
(char-equal
- (funcall 'event-to-character last-input-event) ?\t)
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\t)
(char-equal
- (funcall 'event-to-character last-input-event) ?\ ))))
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\ ))))
t)))
(defun tramp-completion-handle-file-exists-p (filename)
@@ -4478,17 +4647,24 @@ hosts, or files, disagree."
"Set the last-modified timestamp of the given file.
TIME is an Emacs internal time value as returned by `current-time'."
(let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time)))
- (with-parsed-tramp-file-name file nil
- (let ((buf (tramp-get-buffer multi-method method user host)))
- (unless (zerop (tramp-send-command-and-check
- multi-method method user host
- (format "touch -t %s %s"
- touch-time
- localname)))
- (pop-to-buffer buf)
- (error "tramp-touch: touch failed, see buffer `%s' for details"
- buf))))))
-
+ (if (tramp-tramp-file-p file)
+ (with-parsed-tramp-file-name file nil
+ (let ((buf (tramp-get-buffer multi-method method user host)))
+ (unless (zerop (tramp-send-command-and-check
+ multi-method method user host
+ (format "touch -t %s %s"
+ touch-time
+ localname)))
+ (pop-to-buffer buf)
+ (error "tramp-touch: touch failed, see buffer `%s' for details"
+ buf))))
+ ;; It's a local file
+ (with-temp-buffer
+ (unless (zerop (call-process
+ "touch" nil (current-buffer) nil "-t" touch-time file))
+ (pop-to-buffer (current-buffer))
+ (error "tramp-touch: touch failed"))))))
+
(defun tramp-buffer-name (multi-method method user host)
"A name for the connection buffer for USER at HOST using METHOD."
(if multi-method
@@ -4726,16 +4902,16 @@ otherwise."
"Checks whether the given `ls' executable in one of the dirs groks `-n'.
Returns nil if none was found, else the command is returned."
(let ((dl dirlist)
- (result nil)
- (directory-sep-char ?/)) ;for XEmacs
- ;; It would be better to use the CL function `find', but
- ;; we don't want run-time dependencies on CL.
- (while (and dl (not result))
- (let ((x (concat (file-name-as-directory (car dl)) cmd)))
- (when (tramp-check-ls-command multi-method method user host x)
- (setq result x)))
- (setq dl (cdr dl)))
- result))
+ (result nil))
+ (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
+ ;; It would be better to use the CL function `find', but
+ ;; we don't want run-time dependencies on CL.
+ (while (and dl (not result))
+ (let ((x (concat (file-name-as-directory (car dl)) cmd)))
+ (when (tramp-check-ls-command multi-method method user host x)
+ (setq result x)))
+ (setq dl (cdr dl)))
+ result)))
(defun tramp-find-ls-command (multi-method method user host)
"Finds an `ls' command which groks the `-n' option, returning nil if failed.
@@ -4815,6 +4991,24 @@ The terminal type can be configured with `tramp-terminal-type'."
(process-send-string nil (concat tramp-terminal-type
tramp-rsh-end-of-line)))
+(defun tramp-action-process-alive (p multi-method method user host)
+ "Check whether a process has finished."
+ (unless (memq (process-status p) '(run open))
+ (throw 'tramp-action 'process-died)))
+
+(defun tramp-action-out-of-band (p multi-method method user host)
+ "Check whether an out-of-band copy has finished."
+ (cond ((and (memq (process-status p) '(stop exit))
+ (zerop (process-exit-status p)))
+ (tramp-message 9 "Process has finished.")
+ (throw 'tramp-action 'ok))
+ ((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))
+ (t nil)))
+
;; The following functions are specifically for multi connections.
(defun tramp-multi-action-login (p method user host)
@@ -4931,7 +5125,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(erase-buffer)
(tramp-message 10 "Sending command to remote shell: %s"
cmd)
- (tramp-send-command multi-method method user host cmd)
+ (tramp-send-command multi-method method user host cmd nil t)
(tramp-barf-if-no-shell-prompt
p 60 "Remote shell command failed: %s" cmd))
(erase-buffer)))
@@ -4991,7 +5185,7 @@ Maybe the different regular expressions need to be tuned.
user host 'tramp-login-args)))
(found nil)
(pw nil))
- (process-kill-without-query p)
+ (tramp-set-process-query-on-exit-flag p nil)
(set-buffer (tramp-get-buffer multi-method method user host))
(erase-buffer)
(tramp-process-actions p multi-method method user host
@@ -5014,12 +5208,6 @@ Recognition of the remote shell prompt is based on the variables
`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
set up correctly.
-Please note that it is NOT possible to use this connection method with
-an out-of-band transfer method if this function asks the user for a
-password! You must use an inline transfer method in this case.
-Sadly, the transfer method cannot be switched on the fly, instead you
-must specify the right method in the file name.
-
Kludgy feature: if HOST has the form \"xx#yy\", then yy is assumed to
be a port number for ssh, and \"-p yy\" will be added to the list of
arguments, and xx will be used as the host name to connect to.
@@ -5064,7 +5252,7 @@ arguments, and xx will be used as the host name to connect to.
(apply #'start-process bufnam buf login-program
host login-args)))
(found nil))
- (process-kill-without-query p)
+ (tramp-set-process-query-on-exit-flag p nil)
(set-buffer buf)
(tramp-process-actions p multi-method method user host
@@ -5125,7 +5313,7 @@ prompt than you do, so it is not at all unlikely that the variable
user host 'tramp-login-args))))
(found nil)
(pw nil))
- (process-kill-without-query p)
+ (tramp-set-process-query-on-exit-flag p nil)
(set-buffer (tramp-get-buffer multi-method method user host))
(tramp-process-actions p multi-method method user host
tramp-actions-before-shell)
@@ -5178,7 +5366,7 @@ log in as u2 to h2."
tramp-multi-sh-program))
(num-hops (length method))
(i 0))
- (process-kill-without-query p)
+ (tramp-set-process-query-on-exit-flag p nil)
(tramp-message 9 "Waiting 60s for local shell to come up...")
(unless (tramp-wait-for-regexp
p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'"
@@ -5298,12 +5486,16 @@ nil."
(with-timeout (timeout)
(while (not found)
(accept-process-output proc 1)
+ (unless (memq (process-status proc) '(run open))
+ (error "Process has died"))
(goto-char (point-min))
(setq found (when (re-search-forward regexp nil t)
(tramp-match-string-list)))))))
(t
(while (not found)
(accept-process-output proc 1)
+ (unless (memq (process-status proc) '(run open))
+ (error "Process has died"))
(goto-char (point-min))
(setq found (when (re-search-forward regexp nil t)
(tramp-match-string-list))))))
@@ -5358,7 +5550,7 @@ Uses PROMPT as a prompt and sends the password to process P."
;; HHH: Not Changed. This might handle the case where USER is not
;; given in the "File name" very poorly. Then, the local
-;; variable tramp-current user will be set to nil.
+;; variable tramp-current-user will be set to nil.
(defun tramp-pre-connection (multi-method method user host)
"Do some setup before actually logging in.
METHOD, USER and HOST specify the connection."
@@ -5412,6 +5604,10 @@ to set up. METHOD, USER and HOST specify the connection."
(tramp-send-command-internal multi-method method user host
"stty -inlcr -echo kill '^U'")
(erase-buffer)
+ ;; Ignore garbage after stty command.
+ (tramp-send-command-internal multi-method method user host
+ "echo foo")
+ (erase-buffer)
(tramp-send-command-internal multi-method method user host
"TERM=dumb; export TERM")
;; Try to set up the coding system correctly.
@@ -5449,9 +5645,10 @@ to set up. METHOD, USER and HOST specify the connection."
"stty -onlcr"))))
(erase-buffer)
(tramp-message
- 9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1'")
- (tramp-send-command-internal multi-method method user host
- "HISTFILE=$HOME/.tramp_history; HISTSIZE=1")
+ 9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE'")
+ (tramp-send-command-internal
+ multi-method method user host
+ "HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE")
(erase-buffer)
(tramp-message 9 "Waiting 30s for `set +o vi +o emacs'")
(tramp-send-command-internal multi-method method user host
@@ -5858,6 +6055,7 @@ connection. This is meant to be used from
(or neveropen
(tramp-maybe-open-connection multi-method method user host))
(setq tramp-last-cmd-time (current-time))
+ (setq tramp-last-cmd command)
(when tramp-debug-buffer
(save-excursion
(set-buffer (tramp-get-debug-buffer multi-method method user host))
@@ -5886,6 +6084,7 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
(let ((proc (get-buffer-process (current-buffer)))
(found nil)
(start-time (current-time))
+ (start-point (point))
(end-of-output (concat "^"
(regexp-quote tramp-end-of-output)
"\r?$")))
@@ -5905,12 +6104,16 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
(with-timeout (timeout)
(while (not found)
(accept-process-output proc 1)
+ (unless (memq (process-status proc) '(run open))
+ (error "Process has died"))
(goto-char (point-max))
(forward-line -1)
(setq found (looking-at end-of-output))))))
(t
(while (not found)
(accept-process-output proc 1)
+ (unless (memq (process-status proc) '(run open))
+ (error "Process has died"))
(goto-char (point-max))
(forward-line -1)
(setq found (looking-at end-of-output))))))
@@ -5920,6 +6123,12 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
(goto-char (point-max))
(forward-line -2)
(delete-region (point) (point-max)))
+ ;; If processing echoes, look for it in the first line and delete.
+ (when tramp-process-echoes
+ (save-excursion
+ (goto-char start-point)
+ (when (looking-at (regexp-quote tramp-last-cmd))
+ (delete-region (point) (forward-line 1)))))
;; Add output to debug buffer if appropriate.
(when tramp-debug-buffer
(append-to-buffer
@@ -6325,9 +6534,7 @@ If both MULTI-METHOD and METHOD are nil, do a lookup in
(format "%s:%s" host localname)))
(defun tramp-method-out-of-band-p (multi-method method user host)
- "Return t if this is an out-of-band method, nil otherwise.
-It is important to check for this condition, since it is not possible
-to enter a password for the `tramp-copy-program'."
+ "Return t if this is an out-of-band method, nil otherwise."
(tramp-get-method-parameter
multi-method
(tramp-find-method multi-method method user host)
@@ -6502,7 +6709,10 @@ Invokes `password-read' if available, `read-passwd' else."
(if (functionp 'password-read)
(let* ((user (or tramp-current-user (user-login-name)))
(host (or tramp-current-host (system-name)))
- (key (concat user "@" host))
+ (key (if (and (stringp user) (stringp host))
+ (concat user "@" host)
+ (concat "[" (mapconcat 'identity user "/") "]@["
+ (mapconcat 'identity host "/") "]")))
(password (apply #'password-read (list prompt key))))
(apply #'password-cache-add (list key password))
password)
@@ -6581,6 +6791,16 @@ If you want to use it for something else, you'll have to check whether
it does the right thing."
(delete "" (split-string string pattern)))
+(defun tramp-set-process-query-on-exit-flag (process flag)
+ "Specify if query is needed for process when Emacs is exited.
+If the second argument flag is non-nil, Emacs will query the user before
+exiting if process is running."
+ (if (fboundp 'set-process-query-on-exit-flag)
+ (set-process-query-on-exit-flag process flag)
+ (funcall (symbol-function 'process-kill-without-query)
+ process flag)))
+
+
;; ------------------------------------------------------------
;; -- Kludges section --
;; ------------------------------------------------------------
@@ -6714,6 +6934,8 @@ Only works for Bourne-like shells."
tramp-wrong-passwd-regexp
tramp-yesno-prompt-regexp
tramp-yn-prompt-regexp
+ tramp-terminal-prompt-regexp
+ tramp-out-of-band-prompt-regexp
tramp-temp-name-prefix
tramp-file-name-structure
tramp-file-name-regexp
@@ -6725,10 +6947,15 @@ Only works for Bourne-like shells."
tramp-end-of-output
tramp-coding-commands
tramp-actions-before-shell
+ tramp-actions-copy-out-of-band
tramp-multi-actions
tramp-terminal-type
tramp-shell-prompt-pattern
tramp-chunksize
+ ,(when (boundp 'tramp-backup-directory-alist)
+ 'tramp-backup-directory-alist)
+ ,(when (boundp 'tramp-bkup-backup-directory-info)
+ 'tramp-bkup-backup-directory-info)
;; Non-tramp variables of interest
shell-prompt-pattern
@@ -6737,6 +6964,14 @@ Only works for Bourne-like shells."
backup-by-copying-when-mismatch
,(when (boundp 'backup-by-copying-when-privileged-mismatch)
'backup-by-copying-when-privileged-mismatch)
+ ,(when (boundp 'password-cache)
+ 'password-cache)
+ ,(when (boundp 'password-cache-expiry)
+ 'password-cache-expiry)
+ ,(when (boundp 'backup-directory-alist)
+ 'backup-directory-alist)
+ ,(when (boundp 'bkup-backup-directory-info)
+ 'bkup-backup-directory-info)
file-name-handler-alist)
nil ; pre-hook
nil ; post-hook
@@ -6799,7 +7034,6 @@ report.
;; * Rewrite `tramp-shell-quote-argument' to abstain from using
;; `shell-quote-argument'.
;; * Completion gets confused when you leave out the method name.
-;; * Support `dired-compress-file' filename handler.
;; * In Emacs 21, `insert-directory' shows total number of bytes used
;; by the files in that directory. Add this here.
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
@@ -6820,19 +7054,12 @@ report.
;; if it does show files when run locally.
;; * Allow correction of passwords, if the remote end allows this.
;; (Mark Hershberger)
-;; * Make sure permissions of tmp file are good.
-;; (Nelson Minar <nelson@media.mit.edu>)
-;; * Grok passwd prompts with scp? (David Winter
-;; <winter@nevis1.nevis.columbia.edu>). Maybe just do `ssh -l user
-;; host', then wait a while for the passwd or passphrase prompt. If
-;; there is one, remember the passwd/phrase.
;; * How to deal with MULE in `insert-file-contents' and `write-region'?
;; * Do asynchronous `shell-command's.
;; * Grok `append' parameter for `write-region'.
;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
;; * abbreviate-file-name
;; * grok ~ in tramp-remote-path (Henrik Holm <henrikh@tele.ntnu.no>)
-;; * `C' in dired gives error `not tramp file name'.
;; * Also allow to omit user names when doing multi-hop. Not sure yet
;; what the user names should default to, though.
;; * better error checking. At least whenever we see something
@@ -6848,9 +7075,7 @@ report.
;; (Francesco Potort,Al(B)
;; * Should we set PATH ourselves or should we rely on the remote end
;; to do it?
-;; * Do the autoconf thing.
;; * Make it work for XEmacs 20, which is missing `with-timeout'.
-;; * Allow non-Unix remote systems. (More a long-term thing.)
;; * Make it work for different encodings, and for different file name
;; encodings, too. (Daniel Pittman)
;; * Change applicable functions to pass a struct tramp-file-name rather
@@ -6865,13 +7090,6 @@ report.
;; * When editing a remote CVS controlled file as a different user, VC
;; gets confused about the file locking status. Try to find out why
;; the workaround doesn't work.
-;; * When user is running ssh-agent, it would be useful to add the
-;; passwords typed by the user to that agent. This way, the next time
-;; round, the users don't have to type all this in again.
-;; This would be especially useful for start-process, I think.
-;; An easy way to implement start-process is to open a second shell
-;; connection which is inconvenient if the user has to reenter
-;; passwords.
;; * Change `copy-file' to grok the case where the filename handler
;; for the source and the target file are different. Right now,
;; it looks at the source file and then calls that handler, if
@@ -6895,17 +7113,10 @@ report.
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
-;; dired-compress-file
;; dired-uncache -- this will be needed when we do insert-directory caching
;; file-name-as-directory -- use primitive?
-;; file-name-directory -- use primitive?
-;; file-name-nondirectory -- use primitive?
;; file-name-sans-versions -- use primitive?
-;; file-newer-than-file-p
-;; find-backup-file-name
;; get-file-buffer -- use primitive
-;; load
-;; unhandled-file-name-directory
;; vc-registered
;;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a