Add new function to prompt a user for a process name

* lisp/emacs-lisp/subr-x.el (read-process-name): New function
(bug#32640).

1 files changed, 42 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 43e0fc4c9dd..1f69850958c 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -511,6 +511,48 @@ this defaults to the current buffer."
           (put-text-property sub-start sub-end 'display disp)))
       (setq sub-start sub-end))))
 
+;;;###autoload
+(defun read-process-name (prompt)
+  "Query the user for a process and return the process object."
+  ;; Currently supports only the PROCESS argument.
+  ;; Must either return a list containing a process, or signal an error.
+  ;; (Returning `nil' would mean the current buffer's process.)
+  (unless (fboundp 'process-list)
+    (error "Asynchronous subprocesses are not supported on this system"))
+  ;; Local function to return cons of a complete-able name, and the
+  ;; associated process object, for use with `completing-read'.
+  (cl-flet ((procitem
+             (p) (when (process-live-p p)
+                   (let ((pid (process-id p))
+                         (procname (process-name p))
+                         (procbuf (process-buffer p)))
+                     (and (eq (process-type p) 'real)
+                          (cons (if procbuf
+                                    (format "%s (%s) in buffer %s"
+                                            procname pid
+                                            (buffer-name procbuf))
+                                  (format "%s (%s)" procname pid))
+                                p))))))
+    ;; Perform `completing-read' for a process.
+    (let* ((currproc (get-buffer-process (current-buffer)))
+           (proclist (or (process-list)
+                         (error "No processes found")))
+           (collection (delq nil (mapcar #'procitem proclist)))
+           (selection (completing-read
+                       (format-prompt prompt
+                                      (and currproc
+                                           (eq (process-type currproc) 'real)
+                                           (procitem currproc)))
+                       collection nil :require-match nil nil
+                       (car (seq-find (lambda (proc)
+                                        (eq currproc (cdr proc)))
+                                      collection))))
+           (process (and selection
+                         (cdr (assoc selection collection)))))
+      (unless process
+        (error "No process selected"))
+      process)))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here