config/emacs
config/emacs
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add option to get the exit-code and stderr from deferred process

Browse Source
This commit is contained in:
Wojciech Kozlowski 2017-09-09 17:53:17 +01:00
parent e908c27827
commit be266b48aa
1 changed files with 94 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
emacs-deferred/deferred.el
View File

@ -756,6 +756,15 @@ The next deferred object receives stdout and stderr string from
the command process."
(deferred:process-gen 'start-process-shell-command command args))
(defun deferred:process-w-stderr (command &rest args)
"A deferred wrapper of `make-process'. Return a deferred
object. The process name and buffer name of the argument of the
`make-process' are generated by this function automatically. The
next deferred object receives a list containing (exit-code stdout
stderr), where stdout and stderr are strings, from the command
process."
(deferred:process-gen 'make-process command args))
(defun deferred:process-buffer (command &rest args)
"A deferred wrapper of `start-process'. Return a deferred
object. The process name and buffer name of the argument of the
@ -772,62 +781,115 @@ The next deferred object receives stdout and stderr buffer from
the command process."
(deferred:process-buffer-gen 'start-process-shell-command command args))
(defun deferred:process-w-stderr-buffer (command &rest args)
"A deferred wrapper of `make-process'. Return a deferred
object. The process name and buffer name of the argument of the
`make-process' are generated by this function automatically. The
next deferred object receives a list containing (exit-code stdout
stderr), where stdout and stderr are buffers, from the command
process."
(deferred:process-buffer-gen 'make-process command args))
(defun deferred:process-gen (f command args)
"[internal]"
(let ((pd (deferred:process-buffer-gen f command args)) d)
(setq d (deferred:nextc pd
(lambda (buf)
(prog1
(with-current-buffer buf (buffer-string))
(kill-buffer buf)))))
(lambda (output)
(if (eq f 'make-process)
(let ((exit-code (nth 0 output))
(stdout (nth 1 output))
(stderr (nth 2 output)))
(prog1
(list exit-code
(with-current-buffer stdout (buffer-string))
(with-current-buffer stderr (buffer-string)))
(kill-buffer stdout)
(kill-buffer stderr)))
(prog1
(with-current-buffer output (buffer-string))
(kill-buffer output))))))
(setf (deferred-cancel d)
(lambda (_x)
(deferred:default-cancel d)
(deferred:default-cancel pd)))
d))
(defun deferred:run-proc (nd f proc-name buf-name command args)
"[internal]"
(let (proc-buf proc)
(setq proc-buf (get-buffer-create buf-name))
(setq proc
(if (null (car args))
(apply f proc-name buf-name command nil)
(apply f proc-name buf-name command args)))
(set-process-sentinel
proc
(lambda (proc event)
(unless (process-live-p proc)
(if (zerop (process-exit-status proc))
(deferred:post-task nd 'ok proc-buf)
(let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S"
command
(process-status proc)
(process-exit-status proc)
(string-trim-right event)
(if (buffer-live-p proc-buf)
(with-current-buffer proc-buf
(buffer-string))
"(unavailable)"))))
(kill-buffer proc-buf)
(deferred:post-task nd 'ng msg))))))
(setf (deferred-cancel nd)
(lambda (x) (deferred:default-cancel x)
(when proc
(kill-process proc)
(kill-buffer proc-buf))))))
(defun deferred:run-proc-w-stderr (nd proc-name buf-name err-buf-name command args)
"[internal]"
(let (proc-buf proc-err-buf proc)
(setq proc-buf (get-buffer-create buf-name)
proc-err-buf (get-buffer-create err-buf-name))
(setq proc
(make-process
:name proc-name
:buffer buf-name
:command (cons command args)
:sentinel (lambda (proc _event)
(unless (process-live-p proc)
(deferred:post-task nd 'ok
(list (process-exit-status proc)
proc-buf
proc-err-buf))))
:stderr err-buf-name))
(setf (deferred-cancel nd)
(lambda (x) (deferred:default-cancel x)
(when proc
(kill-process proc)
(kill-buffer proc-buf)
(kill-buffer proc-err-buf))))))
(defun deferred:process-buffer-gen (f command args)
"[internal]"
(let ((d (deferred:next)) (uid (deferred:uid)))
(let ((proc-name (format "*deferred:*%s*:%s" command uid))
(buf-name (format " *deferred:*%s*:%s" command uid))
(err-buf-name (format " *deferred:err:*%s*:%s" command uid))
(pwd default-directory)
(env process-environment)
(con-type process-connection-type)
(nd (deferred:new)) proc-buf proc)
(nd (deferred:new)))
(deferred:nextc d
(lambda (_x)
(setq proc-buf (get-buffer-create buf-name))
(condition-case err
(let ((default-directory pwd)
(process-environment env)
(process-connection-type con-type))
(setq proc
(if (null (car args))
(apply f proc-name buf-name command nil)
(apply f proc-name buf-name command args)))
(set-process-sentinel
proc
(lambda (proc event)
(unless (process-live-p proc)
(if (zerop (process-exit-status proc))
(deferred:post-task nd 'ok proc-buf)
(let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S"
command
(process-status proc)
(process-exit-status proc)
(string-trim-right event)
(if (buffer-live-p proc-buf)
(with-current-buffer proc-buf
(buffer-string))
"(unavailable)"))))
(kill-buffer proc-buf)
(deferred:post-task nd 'ng msg))))))
(setf (deferred-cancel nd)
(lambda (x) (deferred:default-cancel x)
(when proc
(kill-process proc)
(kill-buffer proc-buf)))))
(if (eq f 'make-process)
(deferred:run-proc-w-stderr nd
proc-name buf-name err-buf-name command args)
(deferred:run-proc nd
f proc-name buf-name command args)))
(error (deferred:post-task nd 'ng err)))
nil))
nd)))