[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el |
Date: |
Sat, 29 May 2004 18:54:02 -0400 |
Index: emacs/lisp/net/tramp.el
diff -c emacs/lisp/net/tramp.el:1.43 emacs/lisp/net/tramp.el:1.44
*** emacs/lisp/net/tramp.el:1.43 Fri May 7 21:19:48 2004
--- emacs/lisp/net/tramp.el Sat May 29 22:28:49 2004
***************
*** 911,922 ****
:group 'tramp
:type 'regexp)
! (defcustom tramp-out-of-band-prompt-regexp
""
! "Regular expression indicating an out-of-band copy 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-out-of-band', which see."
:group 'tramp
:type 'regexp)
--- 911,923 ----
: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)
***************
*** 1146,1152 ****
;;;###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.")
--- 1147,1153 ----
;;;###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.")
***************
*** 1288,1294 ****
(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))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
Each item looks like (PATTERN ACTION).
--- 1289,1296 ----
(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-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).
***************
*** 1306,1312 ****
(defcustom tramp-actions-copy-out-of-band
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
! (tramp-out-of-band-prompt-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."
--- 1308,1314 ----
(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."
***************
*** 1318,1324 ****
(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))
"List of pattern/action pairs.
This list is used for each hop in multi-hop connections.
See `tramp-actions-before-shell' for more info."
--- 1320,1327 ----
(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-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."
***************
*** 1326,1332 ****
:type '(repeat (list variable function)))
(defcustom tramp-initial-commands
! '("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
--- 1329,1336 ----
:type '(repeat (list variable function)))
(defcustom tramp-initial-commands
! '("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
***************
*** 1768,1773 ****
--- 1772,1778 ----
(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)
***************
*** 2042,2049 ****
"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)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
--- 2047,2054 ----
"Like `file-truename' for tramp files."
(with-parsed-tramp-file-name filename nil
(let* ((steps (tramp-split-string localname "/"))
! (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
! (file-name-as-directory localname)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
***************
*** 2984,2990 ****
;; Use rcp-like program for file transfer.
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf
copy-program copy-args)))
! (process-kill-without-query p)
(tramp-process-actions p multi-method method user host
tramp-actions-copy-out-of-band))
(kill-buffer trampbuf)
--- 2989,2995 ----
;; 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)
***************
*** 3297,3303 ****
;; 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-make-tramp-file-name
multi-method (or method (tramp-find-default-method user host))
user host
--- 3302,3308 ----
;; expand-file-name (this does "/./" and "/../"). We bind
;; directory-sep-char here for XEmacs on Windows, which
;; would otherwise use backslash.
! (tramp-let-maybe directory-sep-char ?/
(tramp-make-tramp-file-name
multi-method (or method (tramp-find-default-method user host))
user host
***************
*** 3525,3530 ****
--- 3530,3538 ----
(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)
***************
*** 3845,3854 ****
;; 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
;; 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
;; function as well but regexp only.
(defun tramp-file-name-for-operation (operation &rest args)
"Return file name related to OPERATION file primitive.
--- 3853,3862 ----
;; 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 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 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.
***************
*** 3862,3877 ****
'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
; XEmacs only
'abbreviate-file-name 'create-file-buffer
'dired-file-modtime 'dired-make-compressed-filename
--- 3870,3885 ----
'dired-compress-file 'dired-uncache
'file-accessible-directory-p 'file-attributes
'file-directory-p 'file-executable-p 'file-exists-p
! '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
***************
*** 3940,3948 ****
(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."
--- 3948,3953 ----
***************
*** 4887,4902 ****
"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))
(defun tramp-find-ls-command (multi-method method user host)
"Finds an `ls' command which groks the `-n' option, returning nil if failed.
--- 4892,4907 ----
"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))
! (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.
***************
*** 4976,4981 ****
--- 4981,4991 ----
(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))
***************
*** 5165,5171 ****
user host 'tramp-login-args)))
(found nil)
(pw nil))
! (process-kill-without-query p)
(set-buffer (tramp-get-buffer multi-method method user host))
(erase-buffer)
(tramp-process-actions p multi-method method user host
--- 5175,5181 ----
user host 'tramp-login-args)))
(found nil)
(pw nil))
! (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
***************
*** 5232,5238 ****
(apply #'start-process bufnam buf login-program
host login-args)))
(found nil))
! (process-kill-without-query p)
(set-buffer buf)
(tramp-process-actions p multi-method method user host
--- 5242,5248 ----
(apply #'start-process bufnam buf login-program
host login-args)))
(found nil))
! (tramp-set-process-query-on-exit-flag p nil)
(set-buffer buf)
(tramp-process-actions p multi-method method user host
***************
*** 5293,5299 ****
user host 'tramp-login-args))))
(found nil)
(pw nil))
! (process-kill-without-query p)
(set-buffer (tramp-get-buffer multi-method method user host))
(tramp-process-actions p multi-method method user host
tramp-actions-before-shell)
--- 5303,5309 ----
user host 'tramp-login-args))))
(found nil)
(pw nil))
! (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)
***************
*** 5346,5352 ****
tramp-multi-sh-program))
(num-hops (length method))
(i 0))
! (process-kill-without-query p)
(tramp-message 9 "Waiting 60s for local shell to come up...")
(unless (tramp-wait-for-regexp
p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'"
--- 5356,5362 ----
tramp-multi-sh-program))
(num-hops (length method))
(i 0))
! (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\\)\\'"
***************
*** 5466,5477 ****
--- 5476,5491 ----
(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))))))
***************
*** 5526,5532 ****
;; 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.
(defun tramp-pre-connection (multi-method method user host)
"Do some setup before actually logging in.
METHOD, USER and HOST specify the connection."
--- 5540,5546 ----
;; 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.
(defun tramp-pre-connection (multi-method method user host)
"Do some setup before actually logging in.
METHOD, USER and HOST specify the connection."
***************
*** 5621,5629 ****
"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")
(erase-buffer)
(tramp-message 9 "Waiting 30s for `set +o vi +o emacs'")
(tramp-send-command-internal multi-method method user host
--- 5635,5644 ----
"stty -onlcr"))))
(erase-buffer)
(tramp-message
! 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
***************
*** 6079,6090 ****
--- 6094,6109 ----
(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))))))
***************
*** 6761,6766 ****
--- 6780,6805 ----
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)))
+
+ (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 'byte-obsolete-variable ',variable)
+ (progn ,@body)
+ (let ((,variable ,value))
+ ,@body)))
+ (put 'tramp-let-maybe 'lisp-indent-function 2)
+
;; ------------------------------------------------------------
;; -- Kludges section --
- [Emacs-diffs] Changes to emacs/lisp/net/tramp.el,
Michael Albinus <=