Allow `process-contact' not to block

* doc/lispref/processes.texi (Process Information): Document it.

* lisp/simple.el (list-processes--refresh): Don't wait for contact
information for non-setup processes.

* src/process.c (Fprocess_contact): Take an optional parameter to
avoid blocking (bug#37408).

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 61de77d06622ad53e8956a6bea9500fca634b943..4c7853bae863fa65d0a67008a967261a96abbc52 100644 (file)
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1042,7 +1042,7 @@ this is either @code{nil}, which means the process is running or
 @end smallexample
 @end defun
 
-@defun process-contact process &optional key
+@defun process-contact process &optional key no-block
 This function returns information about how a network, a serial, or a
 pipe connection was set up.  When @var{key} is @code{nil}, it returns
 @code{(@var{hostname} @var{service})} for a network connection,
@@ -1086,6 +1086,11 @@ connection, see @code{make-pipe-process} for the list of keys.
 
 If @var{key} is a keyword, the function returns the value corresponding
 to that keyword.
+
+If @var{process} is a non-blocking network stream that hasn't been
+fully set up yet, then this function will block until that has
+happened.  If given the optional @var{no-block} parameter, this
+function will return @code{nil} instead of blocking.
 @end defun
 
 @defun process-id process

diff --git a/etc/NEWS b/etc/NEWS
index 567f3cbb4039a37614dea13da67e98c528e9566b..e8d3dffd3bdc5c6743acc7bf672d6e7178afcff7 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2130,6 +2130,10 @@ valid event type.
 \f
 * Lisp Changes in Emacs 27.1
 
++++
+** 'process-contact' now takes an optional NO-BLOCK parameter to allow
+not waiting for a process to be set up.
+
 +++
 ** The new 'quit-window-hook' is now run first when executing the
 'quit-window' command.

diff --git a/lisp/simple.el b/lisp/simple.el
index 358b6a4f2006bcbdab1ae2fea402d2a6d9f9c651..a267200aeb918c889be59b20c6f3423f207969b6 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4107,7 +4107,7 @@ Also, delete any process that is exited or signaled."
                    (t "--")))
                  (cmd
                   (if (memq type '(network serial))
-                      (let ((contact (process-contact p t)))
+                      (let ((contact (process-contact p t t)))
                         (if (eq type 'network)
                             (format "(%s %s)"
                                     (if (plist-get contact :type)

diff --git a/src/process.c b/src/process.c
index 372277a953d90c3145ee5aefd13a26ae6d14256e..a95192d8fba031910e43290664ddbb1fd28a3ea8 100644 (file)
--- a/src/process.c
+++ b/src/process.c
@@ -1456,7 +1456,7 @@ DEFUN ("process-query-on-exit-flag",
 }
 
 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
-       1, 2, 0,
+       1, 3, 0,
        doc: /* Return the contact info of PROCESS; t for a real child.
 For a network or serial or pipe connection, the value depends on the
 optional KEY arg.  If KEY is nil, value is a cons cell of the form
@@ -1465,9 +1465,12 @@ connection; it is t for a pipe connection.  If KEY is t, the complete
 contact information for the connection is returned, else the specific
 value for the keyword KEY is returned.  See `make-network-process',
 `make-serial-process', or `make-pipe-process' for the list of keywords.
+
 If PROCESS is a non-blocking network process that hasn't been fully
-set up yet, this function will block until socket setup has completed.  */)
-  (Lisp_Object process, Lisp_Object key)
+set up yet, this function will block until socket setup has completed.
+If the optional NO-BLOCK parameter is specified, return nil instead of
+waiting for the process to be fully set up.*/)
+  (Lisp_Object process, Lisp_Object key, Lisp_Object no_block)
 {
   Lisp_Object contact;
 
@@ -1476,8 +1479,15 @@ set up yet, this function will block until socket setup has completed.  */)
 
 #ifdef DATAGRAM_SOCKETS
 
-  if (NETCONN_P (process))
-    wait_for_socket_fds (process, "process-contact");
+  if (NETCONN_P (process) && XPROCESS (process)->infd < 0)
+    {
+      /* Usually wait for the network process to finish being set
+       * up. */
+      if (!NILP (no_block))
+       return Qnil;
+
+      wait_for_socket_fds (process, "process-contact");
+    }
 
   if (DATAGRAM_CONN_P (process)
       && (EQ (key, Qt) || EQ (key, QCremote)))