From: Michael Albinus <michael.albinus@gmx.de>
Date: Sun, 19 May 2024 12:13:03 +0000 (+0200)
Subject: Add connection-local variable `tramp-direct-async-process'
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=01de6187738ae612ab7a9f5d3c567325f81bbe0f;p=emacs.git

Add connection-local variable `tramp-direct-async-process'

* doc/misc/tramp.texi (Predefined connection information):
Remove "direct-async-process".
(Remote processes): Explain connection-local variable
tramp-direct-async-process.

* etc/NEWS: Add connection-local variable 'tramp-direct-async-process'.

* lisp/net/tramp-compat.el (tramp-compat-connection-local-p): Sync with
Emacs source.
(tramp-compat-connection-local-value): New defalias.

* lisp/net/tramp-message.el (tramp-warning): New defsubst.

* lisp/net/tramp.el (tramp-direct-async-process): New defvar.
(tramp-direct-async-process-p): Use connection-local variable for
check.  (Bug#70959)

* test/lisp/net/tramp-tests.el
(tramp--test-deftest-direct-async-process):
Use connection-local-variable `tramp-direct-async-process'.

(cherry picked from commit c4cc905d6b01eb049b8d9400da2722d7f818d623)
---

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 034a888a029..05403956ff9 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2320,15 +2320,6 @@ default value is @t{"/data/local/tmp"} for the @option{adb} method,
 @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
 @ref{Temporary directory}.
 
-@item @t{"direct-async-process"}
-
-When this property is non-@code{nil}, an alternative, more performant
-implementation of @code{make-process} and @code{start-file-process} is
-applied.  The connection method must also be marked with a
-non-@code{nil} @code{tramp-direct-async} parameter in
-@code{tramp-methods}.  @ref{Improving performance of asynchronous
-remote processes} for a discussion of constraints.
-
 @item @t{"posix"}
 
 Connections using the @option{smb} method check, whether the remote
@@ -4468,15 +4459,24 @@ Sometimes, this is not needed.  Instead of starting a remote shell and
 running the command afterwards, it is sufficient to run the command
 directly.  @value{tramp} supports this by an alternative
 implementation of @code{make-process} and @code{start-file-process}.
-This is triggered by the connection property
-@t{"direct-async-process"}, @xref{Predefined connection information},
+This is triggered by the connection-local variable
+@code{tramp-direct-async-process},
+@ifinfo
+@xref{Connection Variables, , , emacs},
+@end ifinfo
 which must be set to a non-@code{nil} value.  Example:
 
 @lisp
 @group
-(add-to-list 'tramp-connection-properties
-             (list (regexp-quote "@trampfn{ssh,user@@host,}")
-                   "direct-async-process" t))
+(connection-local-set-profile-variables
+  'remote-direct-async-process
+  '((tramp-direct-async-process . t)))
+@end group
+
+@group
+(connection-local-set-profiles
+ '(:application tramp :machine "remotehost")
+ 'remote-direct-async-process)
 @end group
 @end lisp
 
@@ -4521,6 +4521,12 @@ In order to gain even more performance, it is recommended to bind
 use your own settings in @file{~/.ssh/config}, @pxref{Using ssh
 connection sharing}.
 
+@c Since Emacs 30.
+@strong{Note}: In previous @value{tramp} versions this was triggered
+by the connection property @t{"direct-async-process"}.  This is still
+supported but deprecated, and it will be removed in a future
+@value{tramp} version.
+
 
 @node Cleanup remote connections
 @section Cleanup remote connections
diff --git a/etc/NEWS b/etc/NEWS
index 20a0946bb17..65bddef3060 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1238,6 +1238,14 @@ buffer must either visit a file, or it must run 'dired-mode'.  Another
 method but "sudo" can be configured with user option
 'tramp-file-name-with-method'.
 
++++
+*** Direct asynchronous processes are indicated by a connection-local variable.
+If direct asynchronous processes shall be used, set the connection-local
+variable 'tramp-direct-async-process' to a non-nil value.  This has been
+changed, in previous Emacs versions this was indicated by the now
+deprecated connection property "direct-async-process".  See the Tramp
+manual "(tramp) Improving performance of asynchronous remote processes".
+
 ---
 *** Direct asynchronous processes use 'tramp-remote-path'.
 When a direct asynchronous process is invoked, it uses 'tramp-remote-path'
@@ -1811,9 +1819,11 @@ If non-nil, moving point forward or backward between widgets by typing
 'TAB' or 'S-TAB' skips over inactive widgets.  The default value is nil.
 
 ** Ruby mode
-New user option 'ruby-rubocop-use-bundler'. By default it retains the
-previous behavior: read the contens of Gemfile and act accordingly. But
-you can also set it to t or nil to skip the check.
+
+*** New user option 'ruby-rubocop-use-bundler'.
+By default it retains the previous behavior: read the contents of
+Gemfile and act accordingly.  But you can also set it to t or nil to
+skip the check.
 
 ** Miscellaneous
 
@@ -2121,6 +2131,7 @@ unibyte string.
 
 
 * Lisp Changes in Emacs 30.1
+
 +++
 ** New user option 'compilation-safety' to control safety of native code.
 It's now possible to control how safe is the code generated by native
@@ -2808,15 +2819,14 @@ objects is still necessary.
 ** 'vtable-insert-object' can insert "before" or at an index.
 The signature of 'vtable-insert-object' has changed and is now:
 
-(vtable-insert-object table object &optional location before)
-
-'location' corresponds to the old 'after-object' argument; if 'before'
-is non-nil, the new object is inserted before the 'location' object,
-making it possible to insert a new object at the top of the
-table. (Before, this was not possible.)  In addition, 'location' can be
-an integer, a (zero-based) index into the table at which the new object
-is inserted ('before' is ignored in this case).
+    (vtable-insert-object TABLE OBJECT &optional LOCATION BEFORE)
 
+LOCATION corresponds to the old AFTER-OBJECT argument; if BEFORE is
+non-nil, the new object is inserted before the LOCATION object, making
+it possible to insert a new object at the top of the table.  (Before,
+this was not possible.)  In addition, LOCATION can be an integer, a
+(zero-based) index into the table at which the new object is inserted
+(BEFORE is ignored in this case).
 
 ** JSON
 
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 26c2049fbae..bbffdf7f3d9 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -317,15 +317,46 @@ Also see `ignore'."
       ?\N{KHMER SIGN CAMNUC PII KUUH})
     "List of characters equivalent to trailing colon in \"password\" prompts."))
 
-;; Macro `connection-local-p' is new in Emacs 30.1.
+;; Macros `connection-local-p' and `connection-local-value' are new in
+;; Emacs 30.1.
 (if (macrop 'connection-local-p)
     (defalias 'tramp-compat-connection-local-p 'connection-local-p)
-  (defmacro tramp-compat-connection-local-p (variable)
-    "Non-nil if VARIABLE has a connection-local binding in `default-directory'."
-    `(let (connection-local-variables-alist file-local-variables-alist)
-       (hack-connection-local-variables
-	(connection-local-criteria-for-default-directory))
-       (and (assq ',variable connection-local-variables-alist) t))))
+  (defmacro tramp-compat-connection-local-p (variable &optional application)
+    "Non-nil if VARIABLE has a connection-local binding in `default-directory'.
+`default-directory' must be a remote file name.
+If APPLICATION is nil, the value of
+`connection-local-default-application' is used."
+    (declare (debug (symbolp &optional form)))
+    (unless (symbolp variable)
+      (signal 'wrong-type-argument (list 'symbolp variable)))
+    `(let ((criteria
+            (connection-local-criteria-for-default-directory ,application))
+           connection-local-variables-alist file-local-variables-alist)
+       (when criteria
+	 (hack-connection-local-variables criteria)
+	 (and (assq ',variable connection-local-variables-alist) t)))))
+
+(if (macrop 'connection-local-value)
+    (defalias 'tramp-compat-connection-local-value 'connection-local-value)
+  (defmacro tramp-compat-connection-local-value (variable &optional application)
+    "Return connection-local VARIABLE for APPLICATION in `default-directory'.
+`default-directory' must be a remote file name.
+If APPLICATION is nil, the value of
+`connection-local-default-application' is used.
+If VARIABLE does not have a connection-local binding, the return
+value is the default binding of the variable."
+    (declare (debug (symbolp &optional form)))
+    (unless (symbolp variable)
+      (signal 'wrong-type-argument (list 'symbolp variable)))
+    `(let ((criteria
+            (connection-local-criteria-for-default-directory ,application))
+           connection-local-variables-alist file-local-variables-alist)
+       (if (not criteria)
+           ,variable
+	 (hack-connection-local-variables criteria)
+	 (if-let ((result (assq ',variable connection-local-variables-alist)))
+             (cdr result)
+           ,variable)))))
 
 (dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
   (function-put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 97e94a51e7a..685b14d14db 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -459,6 +459,16 @@ the resulting error message."
          (progn ,@body)
        (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
 
+(defsubst tramp-warning (vec-or-proc fmt-string &rest arguments)
+  "Show a warning.
+VEC-OR-PROC identifies the connection to use, remaining arguments passed
+to `tramp-message'."
+  (declare (tramp-suppress-trace t))
+  (let (signal-hook-function)
+    (apply 'tramp-message vec-or-proc 2 fmt-string arguments)
+    (display-warning
+     'tramp (apply #'format-message fmt-string arguments) :warning)))
+
 (defun tramp-test-message (fmt-string &rest arguments)
   "Emit a Tramp message according `default-directory'."
   (declare (tramp-suppress-trace t))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 182de2ac15d..8f8d3038c3f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4837,15 +4837,41 @@ a connection-local variable."
   (when (process-command proc)
     (tramp-message vec 6 "%s" (string-join (process-command proc) " "))))
 
+(defvar tramp-direct-async-process nil
+  "Whether direct asynchronous processes should be used.
+It is not recommended to change this variable globally.  Instead, it
+should be set conmnection-local.")
+
 (defun tramp-direct-async-process-p (&rest args)
   "Whether direct async `make-process' can be called."
   (let ((v (tramp-dissect-file-name default-directory))
 	(buffer (plist-get args :buffer))
 	(stderr (plist-get args :stderr)))
+    ;; Since Tramp 2.7.1.  In a future release, we'll ignore this
+    ;; connection property.
+    (when (and (not (tramp-compat-connection-local-p
+		     tramp-direct-async-process))
+	       (tramp-connection-property-p v "direct-async-process"))
+      (let ((msg (concat "Connection property \"direct-async-process\" is deprecated, "
+			 "use connection-local variable `tramp-direct-async-process'\n"
+			 "See (info \"(tramp) Improving performance of "
+			 "asynchronous remote processes\")")))
+	(if (tramp-get-connection-property
+	     tramp-null-hop "direct-async-process-warned")
+	    (tramp-message v 2 msg)
+	  (tramp-set-connection-property
+	   tramp-null-hop "direct-async-process-warned" t)
+	  (tramp-warning v msg))))
+
     (and ;; The method supports it.
          (tramp-get-method-parameter v 'tramp-direct-async)
-	 ;; It has been indicated.
-         (tramp-get-connection-property v "direct-async-process")
+	 ;; It has been indicated.  We don't use the global value of
+	 ;; `tramp-direct-async-process'.
+	 (or (and (tramp-compat-connection-local-p tramp-direct-async-process)
+		  (tramp-compat-connection-local-value
+		   tramp-direct-async-process))
+	     ;; Deprecated setting.
+             (tramp-get-connection-property v "direct-async-process"))
 	 ;; There's no multi-hop.
 	 (or (not (tramp-multi-hop-p v))
 	     (null (cdr (tramp-compute-multi-hops v))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 931bc25ef43..4334137681b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5063,11 +5063,18 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
      :tags (append '(:expensive-test :tramp-asynchronous-processes)
 		   (and ,unstable '(:unstable)))
      (skip-unless (tramp--test-enabled))
-     (let ((default-directory ert-remote-temporary-file-directory)
-	   (ert-test (ert-get-test ',test))
-	   (tramp-connection-properties
-	    (cons '(nil "direct-async-process" t)
-		  tramp-connection-properties)))
+     (let* ((default-directory ert-remote-temporary-file-directory)
+	    (ert-test (ert-get-test ',test))
+	    (connection-local-profile-alist
+	     (cons
+	      '(direct-async-process-profile (tramp-direct-async-process . t))
+	      connection-local-profile-alist))
+	    (connection-local-criteria-alist
+	     (cons
+	      `((:application tramp
+		 :machine ,(file-remote-p default-directory 'host))
+		direct-async-process-profile)
+	      connection-local-criteria-alist)))
        (skip-unless (tramp-direct-async-process-p))
        ;; We do expect an established connection already,
        ;; `file-truename' does it by side-effect.  Suppress