[Emacs-diffs] master b8e9baa: Allow `process-contact' not to block

[Lars Ingebrigtsen]

branch: master
commit b8e9baac9ada62c2ea7437579df4be9d4f437fda
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    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).
---
 doc/lispref/processes.texi |  7 ++++++-
 etc/NEWS                   |  4 ++++
 lisp/simple.el             |  2 +-
 src/process.c              | 20 +++++++++++++++-----
 4 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 61de77d..4c7853b 100644
--- 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 567f3cb..e8d3dff 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2131,6 +2131,10 @@ valid event type.
 * 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 358b6a4..a267200 100644
--- 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 372277a..a95192d 100644
--- 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)))