[Emacs-diffs] master 6c560a3 1/2: Adapt accept-process-output timeouts in Tramp

[Michael Albinus]

branch: master
commit 6c560a3b16f9015a19044395f0ef41b718d73496
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Adapt accept-process-output timeouts in Tramp
    
    * lisp/net/tramp.el (tramp-accept-process-output):
    Make timeout optional.  Do not set explicit timer.
    (tramp-action-out-of-band, tramp-process-one-action)
    (tramp-wait-for-regexp, tramp-interrupt-process):
    * lisp/net/tramp-adb.el (tramp-adb-parse-device-names):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
    * lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names):
    * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
    * lisp/net/tramp-smb.el (tramp-smb-action-get-acl)
    (tramp-smb-action-set-acl, tramp-smb-wait-for-output):
    * tramp-sudoedit.el (tramp-sudoedit-action-sudo):
    Adapt `accept-process-output' calls wrt timeouts.
---
 lisp/net/tramp-adb.el      |  3 +--
 lisp/net/tramp-gvfs.el     |  2 +-
 lisp/net/tramp-rclone.el   |  3 +--
 lisp/net/tramp-sh.el       |  2 +-
 lisp/net/tramp-smb.el      | 12 +++++-------
 lisp/net/tramp-sudoedit.el |  2 +-
 lisp/net/tramp.el          | 26 +++++++++++---------------
 7 files changed, 21 insertions(+), 29 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c900d3c..372ce15 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -206,8 +206,7 @@ pass to the OPERATION."
        (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
        (process-put p 'adjust-window-size-function 'ignore)
        (set-process-query-on-exit-flag p nil)
-       (while (or (accept-process-output p 0.1)
-                  (process-live-p p)))
+       (while (accept-process-output p nil nil t))
        (tramp-message v 6 "\n%s" (buffer-string))
        (goto-char (point-min))
        (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f6ff37b..1f14549 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1186,7 +1186,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
        (set-process-filter p 'tramp-gvfs-monitor-process-filter)
        ;; 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)
+       (while (tramp-accept-process-output p))
        (unless (process-live-p p)
          (tramp-error
           p 'file-notify-error "Monitoring not supported for `%s'" file-name))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index f5d184a..bc48d4d 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -183,8 +183,7 @@ pass to the OPERATION."
          (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
          (process-put p 'adjust-window-size-function 'ignore)
          (set-process-query-on-exit-flag p nil)
-         (while (or (accept-process-output p 0.1)
-                    (process-live-p p)))
+         (while (accept-process-output p nil nil t))
          (tramp-message v 6 "\n%s" (buffer-string))
          (goto-char (point-min))
          (while (search-forward-regexp "^\\(\\S-+\\):$" nil t)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index c578a73..e4ea9ec 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3647,7 +3647,7 @@ Fall back to normal file name handler if no Tramp handler 
exists."
        (set-process-filter p filter)
        ;; 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)
+       (while (tramp-accept-process-output p))
        (unless (process-live-p p)
          (tramp-error
           p 'file-notify-error "Monitoring not supported for `%s'" file-name))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 7163afd..a6c9566 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -721,7 +721,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
   "Read ACL data from connection buffer."
   (unless (process-live-p proc)
     ;; Accept pending output.
-    (while (tramp-accept-process-output proc 0.1))
+    (while (tramp-accept-process-output proc))
     (with-current-buffer (tramp-get-connection-buffer vec)
       ;; There might be a hidden password prompt.
       (widen)
@@ -1374,10 +1374,10 @@ component is used as the target of the symlink."
        (delete-file filename)))))
 
 (defun tramp-smb-action-set-acl (proc vec)
-  "Read ACL data from connection buffer."
+  "Set ACL data."
   (unless (process-live-p proc)
     ;; Accept pending output.
-    (while (tramp-accept-process-output proc 0.1))
+    (while (tramp-accept-process-output proc))
     (with-current-buffer (tramp-get-connection-buffer vec)
       (tramp-message vec 10 "\n%s" (buffer-string))
       (throw 'tramp-action 'ok))))
@@ -2043,10 +2043,8 @@ Removes smb prompt.  Returns nil if an error message has 
appeared."
          (inhibit-read-only t))
 
       ;; Read pending output.
-      (goto-char (point-min))
-      (while (not (or (re-search-forward tramp-smb-prompt nil t)
-                     (re-search-forward tramp-smb-errors nil t)))
-       (while (tramp-accept-process-output p 0.1)
+      (while (not (re-search-forward tramp-smb-prompt nil t))
+       (while (tramp-accept-process-output p 0)
          (goto-char (point-min))))
       (tramp-message vec 6 "\n%s" (buffer-string))
 
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index ff3a7d7..6125f6f 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -747,8 +747,8 @@ ID-FORMAT valid values are `string' and `integer'."
   "Check, whether a sudo process has finished.
 Remove unneeded output."
   ;; There might be pending output for the exit status.
-  (while (tramp-accept-process-output proc 0.1))
   (when (not (process-live-p proc))
+    (while (tramp-accept-process-output proc 0))
     ;; Delete narrowed region, it would be in the way reading a Lisp form.
     (goto-char (point-min))
     (widen)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3c7770a..1f018e5 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3977,7 +3977,7 @@ The terminal type can be configured with 
`tramp-terminal-type'."
 (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.
-  (while (tramp-accept-process-output proc 0.1))
+  (while (tramp-accept-process-output proc 0))
   (cond ((and (not (process-live-p proc))
              (zerop (process-exit-status proc)))
         (tramp-message vec 3 "Process has finished.")
@@ -4007,7 +4007,7 @@ The terminal type can be configured with 
`tramp-terminal-type'."
     (while (not found)
       ;; Reread output once all actions have been performed.
       ;; Obviously, the output was not complete.
-      (tramp-accept-process-output proc 1)
+      (while (tramp-accept-process-output proc 0))
       (setq todo actions)
       (while todo
        (setq item (pop todo))
@@ -4078,7 +4078,7 @@ connection buffer."
 
 ;;; Utility functions:
 
-(defun tramp-accept-process-output (proc timeout)
+(defun tramp-accept-process-output (proc &optional timeout)
   "Like `accept-process-output' for Tramp processes.
 This is needed in order to hide `last-coding-system-used', which is set
 for process communication also."
@@ -4088,15 +4088,12 @@ for process communication also."
          ;; We do not want to run timers.
          timer-list timer-idle-list
          result)
-      ;; Under Windows XP, `accept-process-output' doesn't return
-      ;; sometimes.  So we add an additional timeout.  JUST-THIS-ONE
-      ;; is set due to Bug#12145.  It is an integer, in order to avoid
-      ;; running timers as well.
+      ;; JUST-THIS-ONE is set due to Bug#12145.  It is an integer, in
+      ;; order to avoid running timers.
       (tramp-message
-       proc 10 "%s %s %s\n%s"
-       proc (process-status proc)
-       (setq result (with-timeout (timeout)
-                     (accept-process-output proc timeout nil 0)))
+       proc 10 "%s %s %s %s\n%s"
+       proc timeout (process-status proc)
+       (setq result (accept-process-output proc timeout nil 0))
        (buffer-string))
       result)))
 
@@ -4146,14 +4143,14 @@ nil."
       (cond (timeout
             (with-timeout (timeout)
               (while (not found)
-                (tramp-accept-process-output proc 1)
+                (tramp-accept-process-output proc)
                 (unless (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)
+              (tramp-accept-process-output proc)
               (unless (process-live-p proc)
                 (tramp-error-with-buffer
                  nil proc 'file-error "Process has died"))
@@ -4831,8 +4828,7 @@ Only works for Bourne-like shells."
        ;; fall back to the default implementation.
        (with-timeout (1 (ignore))
          ;; We cannot run `tramp-accept-process-output', it blocks timers.
-         (while (or (accept-process-output proc 0.1)
-                    (process-live-p proc)))
+         (while (accept-process-output proc nil nil t))
          ;; Report success.
          proc)))))