[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1c1d5eee4c 1/3: Add new function to prompt a user for a process n
From: |
Lars Ingebrigtsen |
Subject: |
master 1c1d5eee4c 1/3: Add new function to prompt a user for a process name |
Date: |
Sun, 23 Jan 2022 08:37:41 -0500 (EST) |
branch: master
commit 1c1d5eee4c8efb6f2271bb30b32d0cb8ef2afa7d
Author: Phil Sainty <psainty@orcon.net.nz>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add new function to prompt a user for a process name
* lisp/emacs-lisp/subr-x.el (read-process-name): New function
(bug#32640).
---
lisp/emacs-lisp/subr-x.el | 42 ++++++++++++++++++++++++++++++++++++++++++
1 file changed, 42 insertions(+)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 43e0fc4c9d..1f69850958 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