master efaed29: Some precisements in Tramp's connection type handling

[Michael Albinus]

branch: master
commit efaed29f3dc7af15c9f97d87f9cbe790c73a2ea3
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Some precisements in Tramp's connection type handling
    
    * doc/misc/tramp.texi (Remote processes): Precise connection type
    handling.
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
    * lisp/net/tramp-sh.el (tramp-sh-handle-make-process):
    * lisp/net/tramp.el (tramp-handle-make-process):
    Fix :connection-type handling.
    (tramp-action-show-and-confirm-message): Pacify byte compiler.
    
    * lisp/net/tramp-compat.el (tramp-compat-ignore-error): New defmacro.
    
    * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
    (tramp-test30-make-process): Extend tests.
---
 doc/misc/tramp.texi          | 17 ++++----
 lisp/net/tramp-adb.el        |  8 ++--
 lisp/net/tramp-compat.el     |  9 ++++
 lisp/net/tramp-sh.el         |  8 ++--
 lisp/net/tramp.el            | 12 +++---
 test/lisp/net/tramp-tests.el | 99 +++++++++++++++++++++++++++++++-------------
 6 files changed, 103 insertions(+), 50 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index bd9bd99..b2dcddc 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3745,19 +3745,20 @@ tty, or not.  This is controlled by the variable
 @value{tramp} is based on running shells on the remote host, which
 require a pseudo tty.  Therefore, it declares the variable
 @code{tramp-process-connection-type}, which carries this information
-for remote processes.  Per default, its value is @code{t}.  The name
-of the remote pseudo tty is returned by the function
-@code{process-tty-name}.
+for remote processes.  Per default, its value is @code{t}, and there's
+no need to change it.  The name of the remote pseudo tty is returned
+by the function @code{process-tty-name}.
 
 If a remote process, started by @code{start-file-process}, shouldn't
-use a pseudo tty, this is emulated by let-binding this variable to
-@code{nil} or @code{pipe}.  There is still a pseudo tty for the
-started process, but some terminal properties are changed, like
-suppressing translation of carriage return characters into newline.
+use a pseudo tty, this can be indicated by setting
+@code{process-connection-type} to @code{nil} or @code{pipe}.  There is
+still a pseudo tty for the started process, but some terminal
+properties are changed, like suppressing translation of carriage
+return characters into newline.
 
 The function @code{make-process} allows an explicit setting by the
 @code{:connection-type} keyword.  If this keyword is not used, the
-value of @code{tramp-process-connection-type} is applied instead.
+value of @code{process-connection-type} is applied instead.
 
 
 @anchor{Improving performance of asynchronous remote processes}
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c16e232..70dbfdb 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -925,9 +925,7 @@ implementation will be used."
              (coding (plist-get args :coding))
              (noquery (plist-get args :noquery))
              (connection-type
-              (if (plist-member args :connection-type)
-                  (plist-get args :connection-type)
-                tramp-process-connection-type))
+              (or (plist-get args :connection-type) process-connection-type))
              (filter (plist-get args :filter))
              (sentinel (plist-get args :sentinel))
              (stderr (plist-get args :stderr)))
@@ -943,7 +941,9 @@ implementation will be used."
                           (memq (car coding) coding-system-list)
                           (memq (cdr coding) coding-system-list)))
            (signal 'wrong-type-argument (list #'symbolp coding)))
-         (unless (memq connection-type '(nil pipe t pty))
+         (when (eq connection-type t)
+           (setq connection-type 'pty))
+         (unless (memq connection-type '(nil pipe pty))
            (signal 'wrong-type-argument (list #'symbolp connection-type)))
          (unless (or (null filter) (functionp filter))
            (signal 'wrong-type-argument (list #'functionp filter)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b713d5e..125f825 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -295,6 +295,15 @@ A nil value for either argument stands for the current 
time."
     (lambda (reporter &optional value _suffix)
       (progress-reporter-update reporter value))))
 
+;; `ignore-error' is new in Emacs Emacs 27.1.
+(defmacro tramp-compat-ignore-error (condition &rest body)
+  "Execute BODY; if the error CONDITION occurs, return nil.
+Otherwise, return result of last form in BODY.
+
+CONDITION can also be a list of error conditions."
+  (declare (debug t) (indent 1))
+  `(condition-case nil (progn ,@body) (,condition nil)))
+
 ;; `file-modes', `set-file-modes' and `set-file-times' got argument
 ;; FLAG in Emacs 28.1.
 (defalias 'tramp-compat-file-modes
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e0bc28c..a2bf0af 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2765,9 +2765,7 @@ implementation will be used."
              (coding (plist-get args :coding))
              (noquery (plist-get args :noquery))
              (connection-type
-              (if (plist-member args :connection-type)
-                  (plist-get args :connection-type)
-                tramp-process-connection-type))
+              (or (plist-get args :connection-type) process-connection-type))
              (filter (plist-get args :filter))
              (sentinel (plist-get args :sentinel))
              (stderr (plist-get args :stderr)))
@@ -2783,7 +2781,9 @@ implementation will be used."
                           (memq (car coding) coding-system-list)
                           (memq (cdr coding) coding-system-list)))
            (signal 'wrong-type-argument (list #'symbolp coding)))
-         (unless (memq connection-type '(nil pipe t pty))
+         (when (eq connection-type t)
+           (setq connection-type 'pty))
+         (unless (memq connection-type '(nil pipe pty))
            (signal 'wrong-type-argument (list #'symbolp connection-type)))
          (unless (or (null filter) (functionp filter))
            (signal 'wrong-type-argument (list #'functionp filter)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b687eb7..0973b5b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4101,9 +4101,7 @@ substitution.  SPEC-LIST is a list of char/value pairs 
used for
            (coding (plist-get args :coding))
            (noquery (plist-get args :noquery))
            (connection-type
-            (if (plist-member args :connection-type)
-                (plist-get args :connection-type)
-              tramp-process-connection-type))
+            (or (plist-get args :connection-type) process-connection-type))
            (filter (plist-get args :filter))
            (sentinel (plist-get args :sentinel))
            (stderr (plist-get args :stderr)))
@@ -4119,7 +4117,9 @@ substitution.  SPEC-LIST is a list of char/value pairs 
used for
                         (memq (car coding) coding-system-list)
                         (memq (cdr coding) coding-system-list)))
          (signal 'wrong-type-argument (list #'symbolp coding)))
-       (unless (memq connection-type '(nil pipe t pty))
+       (when (eq connection-type t)
+         (setq connection-type 'pty))
+       (unless (memq connection-type '(nil pipe pty))
          (signal 'wrong-type-argument (list #'symbolp connection-type)))
        (unless (or (null filter) (functionp filter))
          (signal 'wrong-type-argument (list #'functionp filter)))
@@ -4702,13 +4702,15 @@ Wait, until the connection buffer changes."
     (let ((stimers (with-timeout-suspend))
          (cursor-in-echo-area t)
          set-message-function clear-message-function)
+      ;; Silence byte compiler.
+      (ignore set-message-function clear-message-function)
       (tramp-message vec 6 "\n%s" (buffer-string))
       (tramp-check-for-regexp proc tramp-process-action-regexp)
       (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 
0))
        ;; Hide message in buffer.
        (narrow-to-region (point-max) (point-max))
        ;; Wait for new output.
-       (while (not (ignore-error 'file-error
+       (while (not (tramp-compat-ignore-error 'file-error
                      (tramp-wait-for-regexp
                       proc 0.1 tramp-security-key-confirmed-regexp)))
          (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 127a9be..9a9684d 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4577,16 +4577,50 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
 
+      ;; Process connection type.
+      (when (and (tramp--test-sh-p)
+                ;; `executable-find' has changed the number of
+                ;; parameters in Emacs 27.1, so we use `apply' for
+                ;; older Emacsen.
+                (ignore-errors
+                  (with-no-warnings
+                    (apply #'executable-find '("hexdump" remote)))))
+       (dolist (process-connection-type '(nil pipe t pty))
+         (unwind-protect
+             (with-temp-buffer
+               (setq proc
+                     (start-file-process
+                      (format "test4-%s" process-connection-type)
+                      (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\""))
+               (should (processp proc))
+               (should (equal (process-status proc) 'run))
+               (process-send-string proc "foo\r\n")
+               (process-send-eof proc)
+               ;; Read output.
+               (with-timeout (10 (tramp--test-timeout-handler))
+                 (while (< (- (point-max) (point-min))
+                           (length "66\n6F\n6F\n0D\n0A\n"))
+                   (while (accept-process-output proc 0 nil t))))
+               (should
+                (string-match-p
+                 (if (memq process-connection-type '(nil pipe))
+                     "66\n6F\n6F\n0D\n0A\n"
+                   "66\n6F\n6F\n0A\n0A\n")
+                 (buffer-string))))
+
+           ;; Cleanup.
+           (ignore-errors (delete-process proc)))))
+
       ;; PTY.
       (unwind-protect
          (with-temp-buffer
            ;; It works only for tramp-sh.el, and not direct async processes.
            (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
                (should-error
-                (start-file-process "test4" (current-buffer) nil)
+                (start-file-process "test5" (current-buffer) nil)
                 :type 'wrong-type-argument)
 
-             (setq proc (start-file-process "test4" (current-buffer) nil))
+             (setq proc (start-file-process "test5" (current-buffer) nil))
              (should (processp proc))
              (should (equal (process-status proc) 'run))
              ;; On MS Windows, `process-tty-name' returns nil.
@@ -4802,34 +4836,41 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
                   (with-no-warnings
                     (apply #'executable-find '("hexdump" remote)))))
        (dolist (connection-type '(nil pipe t pty))
-         (unwind-protect
-             (with-temp-buffer
-               (setq proc
-                     (with-no-warnings
-                       (make-process
-                        :name (format "test7-%s" connection-type)
-                        :buffer (current-buffer)
-                        :connection-type connection-type
-                        :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
-                        :file-handler t)))
-               (should (processp proc))
-               (should (equal (process-status proc) 'run))
-               (process-send-string proc "foo\r\n")
-               (process-send-eof proc)
-               ;; Read output.
-               (with-timeout (10 (tramp--test-timeout-handler))
-                 (while (< (- (point-max) (point-min))
-                           (length "66\n6F\n6F\n0D\n0A\n"))
-                   (while (accept-process-output proc 0 nil t))))
-               (should
-                (string-match-p
-                 (if (memq connection-type '(nil pipe))
-                     "66\n6F\n6F\n0D\n0A\n"
-                   "66\n6F\n6F\n0A\n0A\n")
-                 (buffer-string))))
+         ;; `process-connection-type' is taken when
+         ;; `:connection-type' is nil.
+         (dolist (process-connection-type
+                  (unless connection-type '(nil pipe t pty)))
+           (unwind-protect
+               (with-temp-buffer
+                 (setq proc
+                       (with-no-warnings
+                         (make-process
+                          :name
+                          (format "test7-%s-%s"
+                                  connection-type process-connection-type)
+                          :buffer (current-buffer)
+                          :connection-type connection-type
+                          :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+                          :file-handler t)))
+                 (should (processp proc))
+                 (should (equal (process-status proc) 'run))
+                 (process-send-string proc "foo\r\n")
+                 (process-send-eof proc)
+                 ;; Read output.
+                 (with-timeout (10 (tramp--test-timeout-handler))
+                   (while (< (- (point-max) (point-min))
+                             (length "66\n6F\n6F\n0D\n0A\n"))
+                     (while (accept-process-output proc 0 nil t))))
+                 (should
+                  (string-match-p
+                   (if (memq (or connection-type process-connection-type)
+                             '(nil pipe))
+                       "66\n6F\n6F\n0D\n0A\n"
+                     "66\n6F\n6F\n0A\n0A\n")
+                   (buffer-string))))
 
-           ;; Cleanup.
-           (ignore-errors (delete-process proc))))))))
+             ;; Cleanup.
+             (ignore-errors (delete-process proc)))))))))
 
 (tramp--test--deftest-direct-async-process tramp-test30-make-process
   "Check direct async `make-process'.")