├── README.md ├── doc └── readme.org └── subp.el /README.md: -------------------------------------------------------------------------------- 1 | # subp.el: elisp sub-process library 2 | 3 | 4 | # Installation 5 | 6 | ```emacs-lisp 7 | (elpaca (subp :host github :repo "progfolio/subp")) 8 | ``` 9 | 10 | 11 | # Examples 12 | 13 | 14 | ## subp 15 | 16 | `(subp PROGRAM &rest OPTIONS)` 17 | 18 | Run `PROGRAM` synchronously with `OPTIONS`. `PROGRAM` is a string or a list of form (`PROGRAM` `ARGS`…). If `PROGRAM` contains spaces, it will be split on spaces to supply program args. `OPTIONS` is a may be any of the key value pairs: 19 | 20 | - stdout: \`buffer\` to return a buffer, other values return a string. 21 | - stderr: same as above. 22 | - stdin: File path for program input. @=TODO=: region/buffer as stdin. 23 | - lisp-error: If non-nil, signal Lisp errors, else return Lisp error object. 24 | - namespace: A symbol or string prefixed for anaphoric \`subp-with' bindings. 25 | 26 | The following keywords apply to asynchronous sub processes: 27 | 28 | - async: When non-nil, execute `PROGRAM` asynchronously. 29 | - callback: A function called with at least one arg. Implies :async t. 30 | - cb-args: Additional args to pass to the :callback function 31 | - stop: When non-nil, return a stopped process object. 32 | 33 | Return a list of form (`EXIT` `STDOUT` `STDERR` :=PROPS=…) for synchrous processses. Return a process object for asynchronous processes. 34 | 35 | ```emacs-lisp 36 | (subp "date") 37 | 38 | ;; (0 "Sun Aug 27 07:20:10 PM EDT 2023 39 | ;; " nil) 40 | 41 | ``` 42 | 43 | ```emacs-lisp 44 | (subp "date -R") 45 | 46 | ;; (0 "Sun, 27 Aug 2023 19:20:10 -0400 47 | ;; " nil) 48 | 49 | ``` 50 | 51 | ```emacs-lisp 52 | (subp "date -x") 53 | 54 | ;; (1 nil "/usr/bin/date: invalid option -- 'x' 55 | ;; Try '/usr/bin/date --help' for more information. 56 | ;; ") 57 | 58 | ``` 59 | 60 | ```emacs-lisp 61 | (subp '("bash" "-c" "sleep 2; date")) 62 | 63 | ;; (0 "Sun Aug 27 07:20:12 PM EDT 2023 64 | ;; " nil) 65 | 66 | ``` 67 | 68 | ```emacs-lisp 69 | (subp '("bash" "-c" "sleep 2; date") :callback #'identity) 70 | 71 | ;; # 72 | 73 | ``` 74 | 75 | 76 | ## subp-with 77 | 78 | `(subp-with ARGS &rest BODY)` 79 | 80 | Execute `BODY` in \`subp-with-result' of calling \`subp' with `ARGS`. 81 | 82 | ```emacs-lisp 83 | (subp-with "date" stdout) 84 | 85 | ;; "Sun Aug 27 07:20:12 PM EDT 2023 86 | ;; " 87 | 88 | ``` 89 | 90 | ```emacs-lisp 91 | (subp-with "date -R" exit) 92 | 93 | ;; 0 94 | 95 | ``` 96 | 97 | ```emacs-lisp 98 | (subp-with "date -x" stderr) 99 | 100 | ;; "/usr/bin/date: invalid option -- 'x' 101 | ;; Try '/usr/bin/date --help' for more information. 102 | ;; " 103 | 104 | ``` 105 | 106 | 107 | ## subp-cond 108 | 109 | `(subp-cond ARGS &rest CONDITIONS)` 110 | 111 | Eval `CONDITIONS` in context of \`subp-with' with `ARGS`. 112 | 113 | ```emacs-lisp 114 | (subp-cond "date" (success stdout) (failure stderr)) 115 | 116 | ;; "Sun Aug 27 07:20:12 PM EDT 2023 117 | ;; " 118 | 119 | ``` 120 | 121 | ```emacs-lisp 122 | (subp-cond "date -x" (success stdout) (failure stderr)) 123 | 124 | ;; "/usr/bin/date: invalid option -- 'x' 125 | ;; Try '/usr/bin/date --help' for more information. 126 | ;; " 127 | 128 | ``` -------------------------------------------------------------------------------- /doc/readme.org: -------------------------------------------------------------------------------- 1 | #+title: subp.el: elisp sub-process library 2 | #+author: Nicholas Vollmer 3 | #+options: exports:both timestamp:nil title:t toc:nil 4 | 5 | * Preamble :noexport: 6 | This file generates the README.md file. 7 | To export: 8 | 9 | #+begin_src emacs-lisp :lexical t :results silent 10 | (require 'ox-gfm) 11 | (defun +subp-export-readme () 12 | (with-current-buffer (find-file-noselect "./readme.org") 13 | (org-export-to-file 'gfm "../README.md"))) 14 | 15 | (add-hook 'after-save-hook #'+subp-export-readme nil t) 16 | #+end_src 17 | 18 | * subp.el: elisp sub-process library 19 | 20 | * Installation 21 | :PROPERTIES: 22 | :CUSTOM_ID: installation 23 | :END: 24 | #+begin_src emacs-lisp :lexical t 25 | (elpaca (subp :host github :repo "progfolio/subp")) 26 | #+end_src 27 | 28 | * Examples 29 | :PROPERTIES: 30 | :CUSTOM_ID: examples 31 | :END: 32 | #+begin_src emacs-lisp :lexical t :exports none :results raw 33 | (require 'subp) 34 | (save-excursion ;;@HACK org-babel can't replace raw results otherwise? 35 | (save-restriction 36 | (org-narrow-to-subtree) 37 | (when (zerop (org-next-visible-heading 1)) 38 | (delete-region (point) (point-max)))) 39 | 40 | (cl-flet ((docs (symbol) 41 | (with-temp-buffer 42 | (let ((standard-output (current-buffer))) 43 | (describe-function-1 symbol) 44 | (goto-char (point-min)) 45 | (re-search-forward "\n\n") 46 | (cons (symbol-name symbol) 47 | (cl-remove-if 48 | (lambda (s) (string-match-p "Inferred type" s)) 49 | (split-string (buffer-substring-no-properties (point) (point-max)) 50 | "\n" 'omit-nulls)))))) 51 | (markup-parameters (s) (let (case-fold-search) (replace-regexp-in-string "\\([[:upper:]]\\{2,\\}\\)" "=\\1=" s)))) 52 | (with-temp-buffer 53 | (emacs-lisp-mode) 54 | (cl-loop 55 | with examples = '((subp ("date") ("date -R") ("date -x") 56 | ('("bash" "-c" "sleep 2; date")) 57 | ('("bash" "-c" "sleep 2; date") :callback #'identity)) 58 | (subp-with ("date" stdout) ("date -R" exit) ("date -x" stderr)) 59 | (subp-cond ("date" (success stdout) (failure stderr)) 60 | ("date -x" (success stdout) (failure stderr)))) 61 | for (name arglist . doc) in (mapcar #'docs (mapcar #'car examples)) 62 | for doc = (mapconcat #'markup-parameters doc "\n") 63 | for sym = (intern name) 64 | for exs = (cl-loop for args in (alist-get sym examples) 65 | for form = `(,sym ,@args) 66 | for result = (progn (erase-buffer) 67 | (insert (format "%S" (condition-case err (eval form t) (error err)))) 68 | (comment-region (point-min) (point-max)) 69 | (buffer-string)) 70 | concat (format "#+begin_src emacs-lisp\n%S\n\n%s\n\n#+end_src\n\n" 71 | form result)) 72 | concat (concat (format "** %s\n=%s=\n\n%s\n\n" name arglist doc) exs))))) 73 | #+end_src 74 | 75 | #+RESULTS: 76 | ** subp 77 | =(subp PROGRAM &rest OPTIONS)= 78 | 79 | Run =PROGRAM= synchronously with =OPTIONS=. 80 | =PROGRAM= is a string or a list of form (=PROGRAM= =ARGS=...). 81 | If =PROGRAM= contains spaces, it will be split on spaces to supply program args. 82 | =OPTIONS= is a may be any of the key value pairs: 83 | - stdout: `buffer` to return a buffer, other values return a string. 84 | - stderr: same as above. 85 | - stdin: File path for program input. @=TODO=: region/buffer as stdin. 86 | - lisp-error: If non-nil, signal Lisp errors, else return Lisp error object. 87 | - namespace: A symbol or string prefixed for anaphoric `subp-with' bindings. 88 | The following keywords apply to asynchronous sub processes: 89 | - async: When non-nil, execute =PROGRAM= asynchronously. 90 | - callback: A function called with at least one arg. Implies :async t. 91 | - cb-args: Additional args to pass to the :callback function 92 | - stop: When non-nil, return a stopped process object. 93 | Return a list of form (=EXIT= =STDOUT= =STDERR= :=PROPS=...) for synchrous processses. 94 | Return a process object for asynchronous processes. 95 | 96 | #+begin_src emacs-lisp 97 | (subp "date") 98 | 99 | ;; (0 "Sun Aug 27 07:20:10 PM EDT 2023 100 | ;; " nil) 101 | 102 | #+end_src 103 | 104 | #+begin_src emacs-lisp 105 | (subp "date -R") 106 | 107 | ;; (0 "Sun, 27 Aug 2023 19:20:10 -0400 108 | ;; " nil) 109 | 110 | #+end_src 111 | 112 | #+begin_src emacs-lisp 113 | (subp "date -x") 114 | 115 | ;; (1 nil "/usr/bin/date: invalid option -- 'x' 116 | ;; Try '/usr/bin/date --help' for more information. 117 | ;; ") 118 | 119 | #+end_src 120 | 121 | #+begin_src emacs-lisp 122 | (subp '("bash" "-c" "sleep 2; date")) 123 | 124 | ;; (0 "Sun Aug 27 07:20:12 PM EDT 2023 125 | ;; " nil) 126 | 127 | #+end_src 128 | 129 | #+begin_src emacs-lisp 130 | (subp '("bash" "-c" "sleep 2; date") :callback #'identity) 131 | 132 | ;; # 133 | 134 | #+end_src 135 | 136 | ** subp-with 137 | =(subp-with ARGS &rest BODY)= 138 | 139 | Execute =BODY= in `subp-with-result' of calling `subp' with =ARGS=. 140 | 141 | #+begin_src emacs-lisp 142 | (subp-with "date" stdout) 143 | 144 | ;; "Sun Aug 27 07:20:12 PM EDT 2023 145 | ;; " 146 | 147 | #+end_src 148 | 149 | #+begin_src emacs-lisp 150 | (subp-with "date -R" exit) 151 | 152 | ;; 0 153 | 154 | #+end_src 155 | 156 | #+begin_src emacs-lisp 157 | (subp-with "date -x" stderr) 158 | 159 | ;; "/usr/bin/date: invalid option -- 'x' 160 | ;; Try '/usr/bin/date --help' for more information. 161 | ;; " 162 | 163 | #+end_src 164 | 165 | ** subp-cond 166 | =(subp-cond ARGS &rest CONDITIONS)= 167 | 168 | Eval =CONDITIONS= in context of `subp-with' with =ARGS=. 169 | 170 | #+begin_src emacs-lisp 171 | (subp-cond "date" (success stdout) (failure stderr)) 172 | 173 | ;; "Sun Aug 27 07:20:12 PM EDT 2023 174 | ;; " 175 | 176 | #+end_src 177 | 178 | #+begin_src emacs-lisp 179 | (subp-cond "date -x" (success stdout) (failure stderr)) 180 | 181 | ;; "/usr/bin/date: invalid option -- 'x' 182 | ;; Try '/usr/bin/date --help' for more information. 183 | ;; " 184 | 185 | #+end_src 186 | 187 | -------------------------------------------------------------------------------- /subp.el: -------------------------------------------------------------------------------- 1 | ;;; subp.el --- Elisp library for working with sub-processes -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023-2025 Nicholas Vollmer 4 | 5 | ;; Author: Nicholas Vollmer 6 | ;; URL: https://github.com/progfolio/subp 7 | ;; Created: Aug 22, 2023 8 | ;; Keywords: lisp, convenience 9 | ;; Package-Requires: ((emacs "27.1")) 10 | ;; Version: 0.0.0 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | ;;; @TODO sequences of async subps 27 | 28 | ;; 29 | 30 | ;;; Code: 31 | (eval-when-compile (require 'subr-x)) 32 | (require 'cl-lib) ;;@MAYBE: implement without using `cl-loop' 33 | 34 | (defconst subp--stderr-file 35 | (expand-file-name (format "subp-stderr-%s" (emacs-pid)) temporary-file-directory) 36 | "File for storing processes' stderr.") 37 | 38 | (defun subp--delete-stderr-file () 39 | "Remove `subp--stderr-file'." 40 | (when (and (boundp 'subp-process--stderr) (file-exists-p subp-process--stderr)) 41 | (delete-file subp-process--stderr))) 42 | 43 | ;;@TODO: gate behind user option 44 | (add-hook 'kill-emacs-hook #'subp--delete-stderr-file) 45 | 46 | (defun subp--ensure-list (object) 47 | "Return OBJECT as a list." 48 | (declare (side-effect-free error-free)) 49 | (if (listp object) object (list object))) 50 | 51 | (defun subp-resignal (error) 52 | "Resignal ERROR object." 53 | (signal (car error) (cdr error))) 54 | 55 | (defun subp--declared-option (options option &optional default) 56 | "Return declared OPTION from OPTIONS or DEFAULT." 57 | (if-let ((declared (plist-member options option))) (cadr declared) default)) 58 | 59 | (defun subp--normalize-program-args (program) 60 | "Return normalized list of PROGRAM." 61 | (let ((args (if (consp program) program (split-string program " " 'omit-nulls)))) 62 | (when (string-match-p "/" (car args)) (setf (car args) (expand-file-name (car args)))) 63 | args)) 64 | 65 | (defun subp--process (program options errbuff buffer-p) 66 | "Return stopped PROGRAM sub-process with OPTIONS. 67 | Standard error is associated with ERRBUFF. 68 | If BUFFER-P is non-nil dedicate a buffer to sub-proccess output." 69 | (let ((p (make-process 70 | :name (subp--declared-option options :name "subp") 71 | :buffer (when buffer-p (generate-new-buffer " subp-stdout")) 72 | :command (subp--normalize-program-args program) 73 | :noquery (subp--declared-option options :noquery t) 74 | :connection-type (subp--declared-option options :connection-type 'pipe) 75 | ;;Must be a buffer even if user wants string due to underlying API. 76 | :stderr errbuff))) 77 | ;;`singal-stop' seemed likes a better choice, but it sends SIGSTP, which can be ignored. 78 | ;; SIGSTOP shouldn't be ignored, and sentinel hasn't been isntalled yet. 79 | (signal-process p 'SIGSTOP) 80 | (process-put p :subp-options options) 81 | p)) 82 | 83 | (defun subp--process-option (process key) 84 | "Return KEY's value on PROCESS :subp-options." 85 | (plist-get (process-get process :subp-options) key)) 86 | 87 | (defun subp--concat-filter (key) 88 | "Return process filter for process KEY." 89 | (lambda (process output) 90 | (process-put process key (concat (process-get process key) output)))) 91 | 92 | (defun subp--async-process-sentinel (callback options errbuff) 93 | "Return async process sentinel for CALLBACK with OPTIONS and ERRBUFF." 94 | (lambda (process _) 95 | (when (and (memq (process-status process) '(exit failed signal)) callback) 96 | (apply callback (append (if (process-get process :latep) 97 | (list 'timeout nil nil) 98 | (list (process-exit-status process) 99 | (if (eq (subp--process-option process :stdout) 'buffer) 100 | (process-buffer process) 101 | (process-get process :stdout)) 102 | (if (eq (subp--process-option process :stderr) 'buffer) 103 | errbuff 104 | (process-get process :stderr)))) 105 | (subp--process-option process :props)) 106 | (plist-get options :cb-args))))) 107 | 108 | (defun subp--timeout-process (process) 109 | "Timeout PROCESS." 110 | (process-put process :latep t) 111 | (kill-process process)) 112 | 113 | (defun subp--async (program callback &rest options) 114 | "Eval CALLBACK with results of async PROGRAM with OPTIONS." 115 | (let* ((errbuff (generate-new-buffer " subp-stderr")) 116 | (stdout-buffer-p (eq (plist-get options :stdout) 'buffer)) 117 | (process (subp--process program options errbuff stdout-buffer-p)) 118 | (errproc (get-buffer-process errbuff))) 119 | (unless stdout-buffer-p (set-process-filter process (subp--concat-filter :stdout))) 120 | (set-process-sentinel process (subp--async-process-sentinel callback options errbuff)) 121 | (unless (eq (plist-get options :stderr) 'buffer) 122 | (set-process-filter errproc (subp--concat-filter :stderr))) 123 | (when-let ((timeout (plist-get options :timeout))) 124 | (process-put process :timer 125 | (run-at-time timeout nil #'subp--timeout-process process))) 126 | (if (plist-get options :stop) process (continue-process process)))) 127 | 128 | (defun subp--validate-args (program options) 129 | "Validate PROGRAM and OPTIONS." 130 | (or program (signal 'wrong-type-argument '(nil (stringp (stringp...))))) 131 | (when options (unless (keywordp (car options)) 132 | (signal 'wrong-type-argument (list (car options) 'keywordp))))) 133 | 134 | (defun subp--stdout (bufferp) 135 | "Return stdout string. If BUFFERP is non-nil return `current-buffer'." 136 | (cond ((= (buffer-size) 0) (and (kill-buffer) nil)) 137 | (bufferp (current-buffer)) 138 | (t (prog1 (buffer-substring-no-properties (point-min) (point-max)) 139 | (kill-buffer))))) 140 | 141 | (defun subp--stderr (bufferp) 142 | "Return `subp--stderr-file' stdout string. If BUFFERP is non-nil return buffer." 143 | (unless (= (file-attribute-size (file-attributes subp--stderr-file)) 0) 144 | (with-current-buffer (generate-new-buffer " subp-stderr") 145 | (insert-file-contents subp--stderr-file) 146 | (if bufferp (current-buffer) 147 | (prog1 (buffer-substring-no-properties (point-min) (point-max)) 148 | (kill-buffer)))))) 149 | 150 | (defun subp (program &rest options) 151 | "Run PROGRAM with OPTIONS. 152 | PROGRAM is a string or a list of form (PROGRAM ARGS...). 153 | If PROGRAM contains spaces, it will be split on spaces to supply program args. 154 | OPTIONS is a may be any of the key value pairs: 155 | - stdout: `buffer` to return a buffer, other values return a string. 156 | - stderr: same as above. 157 | - stdin: File path for program input. @TODO: region/buffer as stdin. 158 | - lisp-error: If non-nil, signal Lisp errors, else return Lisp error object. 159 | - namespace: A symbol or string prefixed for anaphoric `subp-with' bindings. 160 | 161 | The following keywords apply to asynchronous sub processes: 162 | 163 | - async: When non-nil, execute PROGRAM asynchronously. 164 | - callback: A function called with at least one arg. Implies :async t. 165 | - cb-args: Additional args to pass to the :callback function 166 | - stop: When non-nil, return a stopped process object. 167 | Return a list of form (EXITCODE STDOUT STDERR PROPS) for synchronous processses. 168 | Return a process object for asynchronous processes." 169 | (condition-case err 170 | (let ((callback (plist-get options :callback))) 171 | (subp--validate-args program options) 172 | (if (or callback (plist-get options :async)) 173 | (apply #'subp--async program callback options) 174 | (let* ((normalized (subp--normalize-program-args program)) 175 | (program (car normalized)) 176 | (args (cdr normalized))) 177 | (with-current-buffer (generate-new-buffer " subp-stdout") 178 | (append (list (apply #'call-process program (plist-get options :stdin) 179 | (list t subp--stderr-file) nil args) 180 | (subp--stdout (eq (plist-get options :stdout) 'buffer)) 181 | (subp--stderr (eq (plist-get options :stderr) 'buffer))) 182 | (subp--ensure-list (plist-get options :props))))))) 183 | (error (if (plist-get options :lisp-error) (subp-resignal err) err)))) 184 | 185 | (defun subps (programs callback &rest options) 186 | "Eval CALLBACK with result of async PROGRAMS. 187 | Return list of PROGRAMS subprocesses. 188 | OPTIONS @TODO: accept options." 189 | (cl-loop 190 | with (required optional) 191 | with progcount = (length programs) 192 | with optcount = (cl-count-if (lambda (program) (plist-get (cdr-safe program) :optional)) 193 | programs) 194 | with limit = (max (- progcount optcount) 1) 195 | with firstp = (= optcount progcount) 196 | for program in programs 197 | for i below progcount 198 | for p = 199 | (apply #'subp 200 | (append 201 | (cond ((consp (car-safe program)) program) ;((program with spaces) args...) 202 | ((consp program) (list (car program))) ;(pogram args...) 203 | (t (list program))) ; program 204 | (list :callback 205 | (lambda (result id self) 206 | (push (cons id result) 207 | (if (plist-get (cdr-safe self) :optional) optional required)) 208 | (when (or (eq (length required) limit) 209 | (and firstp (eq (length optional) limit))) 210 | ;;@TODO: kill outstanding processes 211 | (apply callback 212 | (cl-loop with results = (append required optional) 213 | for i below (length programs) 214 | collect (alist-get i results '(declined nil nil))) 215 | (plist-get options :cb-args)) 216 | ;;Ensure limit can't be reached after this point. 217 | (setq limit -1 firstp nil))) 218 | :stop t ;Prevent process from getting head start while others are created. 219 | :cb-args (list i program)))) 220 | when (listp p) do ;Handle lisp errors immediately in returned result 221 | (push (cons i p) (if (plist-get (cdr-safe program) :optional) optional required)) 222 | collect (if (processp p) (continue-process p) p))) 223 | 224 | (defsubst subp--namespace-symbol (prefix name) 225 | "Reutrn symbol NAME with PREFIX." 226 | (intern (if (not prefix) name (concat prefix name)))) 227 | 228 | (defun subp-result-props (result) 229 | "Return props of RESULT." 230 | (nthcdr 3 result)) 231 | 232 | (defun subp-result-props-get (result key) 233 | "Return KEY's value from RESULT props." 234 | (plist-get (subp-result-props result) key)) 235 | 236 | (defmacro subp-with-result (namespace result &rest body) 237 | "Provide anaphoric RESULT bindings with NAMESPACE for duration of BODY. 238 | RESULT must be an expression which evaluates to subp result. 239 | Anaphoric bindings provided: 240 | result: the raw process result list 241 | exit: the exit code of the process 242 | invoked: t if process was invoked without a Lisp error 243 | success: t if process exited with exit code 0 244 | failure: t if process did not invoke or exited with a nonzero code 245 | err: Lisp error object 246 | stdout: output of stdout 247 | stderr: output of stderr" 248 | (declare (indent 2) (debug t)) 249 | (let* ((ns (or (and namespace (if (stringp namespace) namespace (symbol-name namespace))))) 250 | (rsym (subp--namespace-symbol ns "result")) 251 | (exit (subp--namespace-symbol ns "exit")) 252 | (timeout (subp--namespace-symbol ns "timeout")) 253 | (declined (subp--namespace-symbol ns "declined")) 254 | (invoked (subp--namespace-symbol ns "invoked")) 255 | (success (subp--namespace-symbol ns "success")) 256 | (failure (subp--namespace-symbol ns "failure")) 257 | (err (subp--namespace-symbol ns "err")) 258 | (stdout (subp--namespace-symbol ns "stdout")) 259 | (stderr (subp--namespace-symbol ns "stderr")) 260 | (props (subp--namespace-symbol ns "props"))) 261 | ;;@TODO: simplify bindings. Failure could be non-nil and capture reason. 262 | `(let* ((,rsym ,result) 263 | (,exit (car ,rsym)) 264 | (,timeout (eq ,exit 'timeout)) 265 | (,declined (eq ,exit 'timeout)) 266 | (,invoked (or ,timeout ,declined (numberp ,exit))) 267 | (,success (and (not (or ,timeout ,declined)) ,invoked (zerop ,exit))) 268 | (,failure (and (not ,success) ,exit)) 269 | (,err (and (not (or ,timeout ,declined ,invoked)) ,rsym)) 270 | (,stdout (and ,invoked (nth 1 ,rsym))) 271 | (,stderr (and ,invoked (nth 2 ,rsym))) 272 | (,props (subp-result-props ,result))) 273 | ;; Prevent byte-compiler warnings. 274 | (ignore ,rsym ,exit ,timeout ,declined ,invoked 275 | ,success ,failure ,err ,stdout ,stderr ,props) 276 | ,@body))) 277 | 278 | (defmacro subps-with (spec &rest body) 279 | "Eval BODY with namespaced results of async SPEC programs." 280 | (declare (indent 1) (debug t)) 281 | `(subps (list ,@(mapcar #'cadr spec)) ;;@FIX: spec quoting. 282 | (lambda (results) 283 | (thread-last 284 | (progn ,@body) 285 | ,@(cl-loop for (sym val) in spec 286 | for i below (length spec) 287 | for namespace = 288 | (if val sym (intern (concat "subp" (number-to-string i)))) 289 | collect `(subp-with-result ,namespace (nth ,i results))))))) 290 | 291 | (defmacro subp-with (args &rest body) 292 | "Execute BODY in `subp-with-result' of calling `subp' with ARGS." 293 | (declare (indent 1) (debug t)) ;;@FIX: wrong debug declaration? 294 | (let* ((args (if (or (consp (car-safe args)) (listp args)) args (list args))) 295 | (options (cdr-safe args)) 296 | (callback (plist-get options :callback))) 297 | (when callback (warn "subp :callback replaced by macro BODY: %S" callback)) 298 | (if (or (plist-get options :async) callback) 299 | `(subp--async ,(car args) 300 | (lambda (result) (subp-with-result ,(plist-get options :namespace) 301 | result ,@body)) 302 | ,@options) 303 | `(subp-with-result ,(plist-get options :namespace) 304 | ,@(if (consp (car-safe args)) `((subp ',(car args) ,@(cdr args))) 305 | `((subp ,@args))) 306 | ,@body)))) 307 | 308 | (defmacro subp-cond (args &rest conditions) 309 | "Eval CONDITIONS in context of `subp-with' with ARGS." 310 | (declare (indent 1) (debug t)) 311 | `(subp-with ,args (cond ,@conditions))) 312 | 313 | (provide 'subp) 314 | ;;; subp.el ends here 315 | --------------------------------------------------------------------------------