]> git.eshelyaron.com Git - emacs.git/commitdiff
Use `process-live-p' in Tramp
authorMichael Albinus <michael.albinus@gmx.de>
Mon, 29 Aug 2016 16:39:07 +0000 (18:39 +0200)
committerMichael Albinus <michael.albinus@gmx.de>
Mon, 29 Aug 2016 16:39:07 +0000 (18:39 +0200)
* lisp/net/tramp-compat.el (tramp-compat-process-live-p): New defun.

* lisp/net/tramp.el (tramp-connectable-p, tramp-handle-file-remote-p)
(tramp-handle-file-notify-valid-p)
(tramp-action-process-alive, tramp-action-out-of-band)
(tramp-wait-for-regexp):
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
(tramp-adb-maybe-open-connection):
* lisp/net/tramp-cache.el (tramp-get-connection-property):
* tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
* lisp/net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
(tramp-gw-aux-proc-sentinel, tramp-gw-open-connection):
* tramp-sh.el (tramp-process-sentinel)
(tramp-sh-handle-file-notify-add-watch)
(tramp-maybe-open-connection):
* lisp/net/lisp/net/lisp/net/tramp-smb.el (tramp-smb-action-with-tar)
(tramp-smb-handle-copy-directory, tramp-smb-action-get-acl)
(tramp-smb-handle-process-file, tramp-smb-action-set-acl)
(tramp-smb-get-cifs-capabilities)
(tramp-smb-get-stat-capability)
(tramp-smb-maybe-open-connection, tramp-smb-wait-for-output)
(tramp-smb-kill-winexe-function): Use it.

lisp/net/tramp-adb.el
lisp/net/tramp-cache.el
lisp/net/tramp-compat.el
lisp/net/tramp-gvfs.el
lisp/net/tramp-gw.el
lisp/net/tramp-sh.el
lisp/net/tramp-smb.el
lisp/net/tramp.el

index 24b732255d422d446bc91997c041f77886946b6a..48a05a7bf4f294ca6226382e7167ad32ddde4841 100644 (file)
@@ -202,7 +202,7 @@ pass to the OPERATION."
            result)
        (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
        (set-process-query-on-exit-flag p nil)
-       (while (eq 'run (process-status p))
+       (while (tramp-compat-process-live-p p)
          (accept-process-output p 0.1))
        (accept-process-output p 0.1)
        (tramp-message v 6 "\n%s" (buffer-string))
@@ -1168,8 +1168,7 @@ connection if a previous connection has died for some reason."
     (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
       (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
 
-    (unless
-       (and p (processp p) (memq (process-status p) '(run open)))
+    (unless (tramp-compat-process-live-p p)
       (save-match-data
        (when (and p (processp p)) (delete-process p))
        (if (zerop (length device))
@@ -1188,7 +1187,7 @@ connection if a previous connection has died for some reason."
             vec 6 "%s" (mapconcat 'identity (process-command p) " "))
            ;; Wait for initial prompt.
            (tramp-adb-wait-for-output p 30)
-           (unless (eq 'run (process-status p))
+           (unless (tramp-compat-process-live-p p)
              (tramp-error  vec 'file-error "Terminated!"))
            (tramp-set-connection-property p "vector" vec)
            (set-process-query-on-exit-flag p nil)
index 76b49a09e3ac9526d33504c53ddc567e50f53d1b..9a2ff0b099f9068654941a1aa2d7f251ad09c0da 100644 (file)
@@ -240,7 +240,7 @@ connection, returns DEFAULT."
         (value
          ;; If the key is an auxiliary process object, check whether
          ;; the process is still alive.
-         (if (and (processp key) (not (memq (process-status key) '(run open))))
+         (if (and (processp key) (not (tramp-compat-process-live-p key)))
              default
            (if (hash-table-p hash)
                (gethash property hash default)
index b2f910165852f0aff120e41c449505172b853589..19e48f6f251b38332725aef91c812214568961ff 100644 (file)
@@ -248,6 +248,19 @@ Add the extension of F, if existing."
                                     process-name))))
              (setq result t)))))))))
 
+;; `process-running-live-p' is introduced in Emacs 24.
+(defalias 'tramp-compat-process-live-p
+  (if (fboundp 'process-running-live-p)
+      'process-running-live-p
+    (lambda (process)
+      "Returns non-nil if PROCESS is alive.
+A process is considered alive if its status is `run', `open',
+`listen', `connect' or `stop'.  Value is nil if PROCESS is not a
+process."
+      (and (processp process)
+          (memq (process-status process)
+                '(run open listen connect stop))))))
+
 ;; `default-toplevel-value' has been declared in Emacs 24.
 (unless (fboundp 'default-toplevel-value)
   (defalias 'default-toplevel-value 'symbol-value))
index 82abf542c5e01b54deecb3b25f077cbcf5022afc..398fc87870c9b8f7db76e797cf6485d60fb0b682 100644 (file)
@@ -1084,7 +1084,7 @@ file names."
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
        (tramp-accept-process-output p 1)
-       (unless (memq (process-status p) '(run open))
+       (unless (tramp-compat-process-live-p p)
          (tramp-error
           v 'file-notify-error "Monitoring not supported for `%s'" file-name))
        p))))
index ecf1436d599399b57813e05fee38b0fbfb24fc59..5f9720ff650e4a275ca3c3d56cb67d956ab457d0 100644 (file)
@@ -93,7 +93,7 @@
 
 (defun tramp-gw-gw-proc-sentinel (proc _event)
   "Delete auxiliary process when we are deleted."
-  (unless (memq (process-status proc) '(run open))
+  (unless (tramp-compat-process-live-p proc)
     (tramp-message
      tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc)
     (let* ((tramp-verbose 0)
 
 (defun tramp-gw-aux-proc-sentinel (proc _event)
   "Activate the different filters for involved gateway and auxiliary processes."
-  (when (memq (process-status proc) '(run open))
+  (when (tramp-compat-process-live-p proc)
     ;; A new process has been spawned from `tramp-gw-aux-proc'.
     (tramp-message
      tramp-gw-vector 4
@@ -149,8 +149,7 @@ instead of the host name declared in TARGET-VEC."
        tramp-gw-gw-vector gw-vec)
 
   ;; Start listening auxiliary process.
-  (unless (and (processp tramp-gw-aux-proc)
-              (memq (process-status tramp-gw-aux-proc) '(listen)))
+  (unless (tramp-compat-process-live-p tramp-gw-aux-proc)
     (let ((aux-vec
           (vector "aux" (tramp-file-name-user gw-vec)
                   (tramp-file-name-host gw-vec) nil nil)))
index 9afa85e8cebfdaaa8be17495eddb7942702eb9bc..61d853f111e8b8ec7fe6451bf542dc4db2b4fd95 100644 (file)
@@ -2839,7 +2839,7 @@ the result will be a local, non-Tramp, file name."
 
 (defun tramp-process-sentinel (proc event)
   "Flush file caches."
-  (unless (memq (process-status proc) '(run open))
+  (unless (tramp-compat-process-live-p proc)
     (let ((vec (tramp-get-connection-property proc "vector" nil)))
       (when vec
        (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
@@ -3641,7 +3641,7 @@ Fall back to normal file name handler if no Tramp handler exists."
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
        (tramp-accept-process-output p 1)
-       (unless (memq (process-status p) '(run open))
+       (unless (tramp-compat-process-live-p p)
          (tramp-error
           v 'file-notify-error "Monitoring not supported for `%s'" file-name))
        p))))
@@ -4649,7 +4649,7 @@ connection if a previous connection has died for some reason."
 
     ;; If Tramp opens the same connection within a short time frame,
     ;; there is a problem.  We shall signal this.
-    (unless (or (and p (processp p) (memq (process-status p) '(run open)))
+    (unless (or (tramp-compat-process-live-p p)
                (not (equal (butlast (append vec nil) 2)
                            (car tramp-current-connection)))
                (> (tramp-time-diff
@@ -4670,9 +4670,9 @@ connection if a previous connection has died for some reason."
                       (tramp-get-connection-property
                        p "last-cmd-time" '(0 0 0)))
                      60)
-                  p (processp p) (memq (process-status p) '(run open)))
+                  (tramp-compat-process-live-p p))
          (tramp-send-command vec "echo are you awake" t t)
-         (unless (and (memq (process-status p) '(run open))
+         (unless (and (tramp-compat-process-live-p p)
                       (tramp-wait-for-output p 10))
            ;; The error will be caught locally.
            (tramp-error vec 'file-error "Awake did fail")))
@@ -4682,7 +4682,7 @@ connection if a previous connection has died for some reason."
 
     ;; New connection must be opened.
     (condition-case err
-       (unless (and p (processp p) (memq (process-status p) '(run open)))
+       (unless (tramp-compat-process-live-p p)
 
          ;; If `non-essential' is non-nil, don't reopen a new connection.
          ;; This variable has been introduced with Emacs 24.1.
index be7eb88b9c74dd2b756af728c0a24fb5ffe9409f..05ce6041a8b23adf56afe81dd57224f4049ccffe 100644 (file)
@@ -388,7 +388,7 @@ pass to the OPERATION."
 
 (defun tramp-smb-action-with-tar (proc vec)
   "Untar from connection buffer."
-  (if (not (memq (process-status proc) '(run open)))
+  (if (not (tramp-compat-process-live-p proc))
       (throw 'tramp-action 'process-died)
 
     (with-current-buffer (tramp-get-connection-buffer vec)
@@ -520,7 +520,7 @@ pass to the OPERATION."
                      (set-process-query-on-exit-flag p nil)
                      (tramp-process-actions p v nil tramp-smb-actions-with-tar)
 
-                     (while (memq (process-status p) '(run open))
+                     (while (tramp-compat-process-live-p p)
                        (sit-for 0.1))
                      (tramp-message v 6 "\n%s" (buffer-string))))
 
@@ -705,7 +705,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
 
 (defun tramp-smb-action-get-acl (proc vec)
   "Read ACL data from connection buffer."
-  (when (not (memq (process-status proc) '(run open)))
+  (unless (tramp-compat-process-live-p proc)
     ;; Accept pending output.
     (while (tramp-accept-process-output proc 0.1))
     (with-current-buffer (tramp-get-connection-buffer vec)
@@ -1218,7 +1218,7 @@ target of the symlink differ."
            (narrow-to-region (point-max) (point-max))
            (let ((p (tramp-get-connection-process v)))
              (tramp-smb-send-command v "exit $lasterrorcode")
-             (while (memq (process-status p) '(run open))
+             (while (tramp-compat-process-live-p p)
                (sleep-for 0.1)
                (setq ret (process-exit-status p))))
            (delete-region (point-min) (point-max))
@@ -1302,7 +1302,7 @@ target of the symlink differ."
 
 (defun tramp-smb-action-set-acl (proc vec)
   "Read ACL data from connection buffer."
-  (when (not (memq (process-status proc) '(run open)))
+  (unless (tramp-compat-process-live-p proc)
     ;; Accept pending output.
     (while (tramp-accept-process-output proc 0.1))
     (with-current-buffer (tramp-get-connection-buffer vec)
@@ -1718,8 +1718,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
 (defun tramp-smb-get-cifs-capabilities (vec)
   "Check, whether the SMB server supports POSIX commands."
   ;; When we are not logged in yet, we return nil.
-  (if (let ((p (tramp-get-connection-process vec)))
-       (and p (processp p) (memq (process-status p) '(run open))))
+  (if (tramp-compat-process-live-p (tramp-get-connection-process vec))
       (with-tramp-connection-property
          (tramp-get-connection-process vec) "cifs-capabilities"
        (save-match-data
@@ -1737,8 +1736,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
   "Check, whether the SMB server supports the STAT command."
   ;; When we are not logged in yet, we return nil.
   (if (and (tramp-smb-get-share vec)
-          (let ((p (tramp-get-connection-process vec)))
-            (and p (processp p) (memq (process-status p) '(run open)))))
+          (tramp-compat-process-live-p (tramp-get-connection-process vec)))
       (with-tramp-connection-property
          (tramp-get-connection-process vec) "stat-capability"
        (tramp-smb-send-command vec "stat \"/\""))))
@@ -1805,18 +1803,17 @@ If ARGUMENT is non-nil, use it as argument for
                     (tramp-get-connection-property
                      p "last-cmd-time" '(0 0 0)))
                    60)
-                p (processp p) (memq (process-status p) '(run open))
+                (tramp-compat-process-live-p p)
                 (re-search-forward tramp-smb-errors nil t))
        (delete-process p)
        (setq p nil)))
 
     ;; Check whether it is still the same share.
-    (unless
-       (and p (processp p) (memq (process-status p) '(run open))
-            (or argument
-                (string-equal
-                 share
-                 (tramp-get-connection-property p "smb-share" ""))))
+    (unless (and (tramp-compat-process-live-p p)
+                (or argument
+                    (string-equal
+                     share
+                     (tramp-get-connection-property p "smb-share" ""))))
 
       (save-match-data
        ;; There might be unread output from checking for share names.
@@ -1947,7 +1944,7 @@ Returns nil if an error message has appeared."
       ;; Algorithm: get waiting output.  See if last line contains
       ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
       ;; If not, wait a bit and again get waiting output.
-      (while (and (not found) (not err) (memq (process-status p) '(run open)))
+      (while (and (not found) (not err) (tramp-compat-process-live-p p))
 
        ;; Accept pending output.
        (tramp-accept-process-output p 0.1)
@@ -1961,7 +1958,7 @@ Returns nil if an error message has appeared."
        (setq err (re-search-forward tramp-smb-errors nil t)))
 
       ;; When the process is still alive, read pending output.
-      (while (and (not found) (memq (process-status p) '(run open)))
+      (while (and (not found) (tramp-compat-process-live-p p))
 
        ;; Accept pending output.
        (tramp-accept-process-output p 0.1)
@@ -1985,7 +1982,7 @@ Returns nil if an error message has appeared."
   "Send SIGKILL to the winexe process."
   (ignore-errors
     (let ((p (get-buffer-process (current-buffer))))
-      (when (and p (processp p) (memq (process-status p) '(run open)))
+      (when (tramp-compat-process-live-p p)
        (signal-process (process-id p) 'SIGINT)))))
 
 (defun tramp-smb-call-winexe (vec)
index f262b739ad5bc5854101ed5e3c493e284376e779..4e9d4c29cd4df73b8d70465e8337cfc8ba74a638 100644 (file)
@@ -939,14 +939,14 @@ checked via the following code:
         (erase-buffer)
         (let ((proc (start-process (buffer-name) (current-buffer)
                                    \"ssh\" \"-l\" user host \"wc\" \"-c\")))
-          (when (memq (process-status proc) \\='(run open))
+          (when (process-live-p proc)
             (process-send-string proc (make-string sent ?\\ ))
             (process-send-eof proc)
             (process-send-eof proc))
           (while (not (progn (goto-char (point-min))
                              (re-search-forward \"\\\\w+\" (point-max) t)))
             (accept-process-output proc 1))
-          (when (memq (process-status proc) \\='(run open))
+          (when (process-live-p proc)
             (setq received (string-to-number (match-string 0)))
             (delete-process proc)
             (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
@@ -2284,11 +2284,10 @@ should never be set globally, the intention is to let-bind it.")
 This is true, if either the remote host is already connected, or if we are
 not in completion mode."
   (and (tramp-tramp-file-p filename)
-       (with-parsed-tramp-file-name filename nil
-        (or (not (tramp-completion-mode-p))
-            (let* ((tramp-verbose 0)
-                   (p (tramp-get-connection-process v)))
-              (and p (processp p) (memq (process-status p) '(run open))))))))
+       (or (not (tramp-completion-mode-p))
+          (tramp-compat-process-live-p
+           (tramp-get-connection-process
+            (tramp-dissect-file-name filename))))))
 
 (defun tramp-completion-handle-expand-file-name (name &optional dir)
   "Like `expand-file-name' for Tramp files."
@@ -2942,7 +2941,7 @@ User is always nil."
     (when (tramp-tramp-file-p filename)
       (let* ((v (tramp-dissect-file-name filename))
             (p (tramp-get-connection-process v))
-            (c (and p (processp p) (memq (process-status p) '(run open))
+            (c (and (tramp-compat-process-live-p p)
                     (tramp-get-connection-property p "connected" nil))))
        ;; We expand the file name only, if there is already a connection.
        (with-parsed-tramp-file-name
@@ -3344,7 +3343,7 @@ of."
 
 (defun tramp-handle-file-notify-valid-p (proc)
   "Like `file-notify-valid-p' for Tramp files."
-  (and proc (processp proc) (memq (process-status proc) '(run open))
+  (and (tramp-compat-process-live-p proc)
        ;; Sometimes, the process is still in status `run' when the
        ;; file or directory to be watched is deleted already.
        (with-current-buffer (process-buffer proc)
@@ -3439,14 +3438,14 @@ The terminal type can be configured with `tramp-terminal-type'."
 
 (defun tramp-action-process-alive (proc _vec)
   "Check, whether a process has finished."
-  (unless (memq (process-status proc) '(run open))
+  (unless (tramp-compat-process-live-p proc)
     (throw 'tramp-action 'process-died)))
 
 (defun tramp-action-out-of-band (proc vec)
   "Check, whether an out-of-band copy has finished."
   ;; There might be pending output for the exit status.
   (tramp-accept-process-output proc 0.1)
-  (cond ((and (memq (process-status proc) '(stop exit))
+  (cond ((and (not (tramp-compat-process-live-p proc))
              (zerop (process-exit-status proc)))
         (tramp-message vec 3 "Process has finished.")
         (throw 'tramp-action 'ok))
@@ -3608,14 +3607,14 @@ nil."
             (with-timeout (timeout)
               (while (not found)
                 (tramp-accept-process-output proc 1)
-                (unless (memq (process-status proc) '(run open))
+                (unless (tramp-compat-process-live-p proc)
                   (tramp-error-with-buffer
                    nil proc 'file-error "Process has died"))
                 (setq found (tramp-check-for-regexp proc regexp)))))
            (t
             (while (not found)
               (tramp-accept-process-output proc 1)
-              (unless (memq (process-status proc) '(run open))
+              (unless (tramp-compat-process-live-p proc)
                 (tramp-error-with-buffer
                  nil proc 'file-error "Process has died"))
               (setq found (tramp-check-for-regexp proc regexp)))))