Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add some process helping functions #974

Draft
wants to merge 4 commits into
base: main
Choose a base branch
from
Draft

Add some process helping functions #974

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
c557a85
Add output-buffer as a buffer process attribute
Sasanidas Aug 20, 2023
f492fbb
Add otuput-buffer parameter and process-hash to save processes
Sasanidas Aug 20, 2023
5aebffa
Merge branch 'lem-project:main' into process-information-buffer
Sasanidas Aug 21, 2023
fb825c2
Merge branch 'main' into process-information-buffer
Sasanidas Nov 3, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 17 additions & 3 deletions lib/process/process.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,18 +20,27 @@
(output-callback
:initarg :output-callback
:reader process-output-callback)
(output-buffer
:initarg :output-buffer
:reader process-output-buffer
:type lem:buffer)
(callback-type
:initarg :output-callback-type
:reader process-output-callback-type)))

(defun run-process (command &key name output-callback output-callback-type directory)
(defvar *process-hash* (make-hash-table :test #'equal))

(defun run-process (command &key name output-callback output-callback-type directory output-buffer)
(setf command (uiop:ensure-list command))
(let ((buffer-stream (make-string-output-stream)))
(let ((buffer-stream (make-string-output-stream))
(process-buffer (or output-buffer
(make-buffer (format nil "*process-~a* " name)))))
(let* ((pointer (async-process:create-process command :nonblock nil :directory directory))
(process (make-instance 'process
:pointer pointer
:name name
:command command
:output-buffer process-buffer
:buffer-stream buffer-stream
;; :read-thread thread
:output-callback output-callback
Expand All @@ -41,13 +50,18 @@
(loop
(unless (async-process:process-alive-p pointer)
(return))
(send-event (lambda ()
(with-point ((p (buffer-point (get-buffer process-buffer))))
(lem:insert-string p (get-process-output-string process)))))
(alexandria:when-let
(string (async-process:process-receive-output pointer))
(send-event (lambda ()
(write-to-buffer process string))))))
:name (format nil "run-process ~{~A~^ ~}" command))))
(set-process-read-thread thread process)
process)))
(prog1
process
(setf (gethash name *process-hash*) process)))))

(defun get-process-output-string (process)
(get-output-stream-string (process-buffer-stream process)))
Expand Down