summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2016-08-29 18:39:07 +0200
committerMichael Albinus <michael.albinus@gmx.de>2016-08-29 18:39:07 +0200
commit1d0d6d9296414686ce17b8731fba66c56f904ee8 (patch)
tree03b83f66f582f21fe43bcb0579eba2ef3cd2bbe1 /lisp
parent472ebd86277d26e6a7194e0e66fc171439fd8f44 (diff)
Use `process-live-p' in Tramp
* 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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/net/tramp-adb.el7
-rw-r--r--lisp/net/tramp-cache.el2
-rw-r--r--lisp/net/tramp-compat.el13
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-gw.el7
-rw-r--r--lisp/net/tramp-sh.el12
-rw-r--r--lisp/net/tramp-smb.el35
-rw-r--r--lisp/net/tramp.el25
8 files changed, 55 insertions, 48 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 24b732255d..48a05a7bf4 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 76b49a09e3..9a2ff0b099 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -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)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b2f9101658..19e48f6f25 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -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))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 82abf542c5..398fc87870 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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))))
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index ecf1436d59..5f9720ff65 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -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)
@@ -102,7 +102,7 @@
(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)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 9afa85e8ce..61d853f111 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index be7eb88b9c..05ce6041a8 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f262b739ad..4e9d4c29cd 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)))))