[Emacs-diffs] Changes to emacs/lisp/net/tramp.el

[Michael Albinus]

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 --