diff --git a/deferred.el b/deferred.el index 041c90b..02fa092 100644 --- a/deferred.el +++ b/deferred.el @@ -746,7 +746,16 @@ object. The process name and buffer name of the argument of the `start-process' are generated by this function automatically. The next deferred object receives stdout and stderr string from the command process." - (deferred:process-gen 'start-process command args)) + (deferred:process-gen 'start-process nil command args)) + +(defun deferred:process-ec (command &rest args) + "A deferred wrapper of `start-process'. Return a deferred +object. The process name and buffer name of the argument of the +`start-process' are generated by this function automatically. +The next deferred object receives the list (exit-code output), +where the output is the stdout and stderr as one string from the +command process." + (deferred:process-gen 'start-process 'w-exit-code command args)) (defun deferred:process-shell (command &rest args) "A deferred wrapper of `start-process-shell-command'. Return a deferred @@ -754,7 +763,16 @@ object. The process name and buffer name of the argument of the `start-process-shell-command' are generated by this function automatically. The next deferred object receives stdout and stderr string from the command process." - (deferred:process-gen 'start-process-shell-command command args)) + (deferred:process-gen 'start-process-shell-command nil command args)) + +(defun deferred:process-shell-ec (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a +deferred object. The process name and buffer name of the argument +of the `start-process-shell-command' are generated by this +function automatically. The next deferred object receives the +list (exit-code output), where the output is the stdout and +stderr as one string from the command process." + (deferred:process-gen 'start-process-shell-command 'w-exit-code command args)) (defun deferred:process-buffer (command &rest args) "A deferred wrapper of `start-process'. Return a deferred @@ -762,7 +780,16 @@ object. The process name and buffer name of the argument of the `start-process' are generated by this function automatically. The next deferred object receives stdout and stderr buffer from the command process." - (deferred:process-buffer-gen 'start-process command args)) + (deferred:process-buffer-gen 'start-process nil command args)) + +(defun deferred:process-ec-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 +`start-process' are generated by this function automatically. +The next deferred object receives the list (exit-code output), +where the output is the stdout and stderr in one buffer from the +command process." + (deferred:process-buffer-gen 'start-process 'w-exit-code command args)) (defun deferred:process-shell-buffer (command &rest args) "A deferred wrapper of `start-process-shell-command'. Return a deferred @@ -770,23 +797,36 @@ object. The process name and buffer name of the argument of the `start-process-shell-command' are generated by this function automatically. 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-gen (f command args) + (deferred:process-buffer-gen 'start-process-shell-command nil command args)) + +(defun deferred:process-shell-ec-buffer (command &rest args) + "A deferred wrapper of `start-process-shell-command'. Return a +deferred object. The process name and buffer name of the argument +of the `start-process-shell-command' are generated by this +function automatically. The next deferred object receives the +list (exit-code output), where the output is the stdout and +stderr in one buffer from the command process." + (deferred:process-buffer-gen 'start-process-shell-command 'w-exit-code command args)) + +(defun deferred:process-gen (f w-exit-code command args) "[internal]" - (let ((pd (deferred:process-buffer-gen f command args)) d) + (let ((pd (deferred:process-buffer-gen f w-exit-code command args)) d) (setq d (deferred:nextc pd - (lambda (buf) - (prog1 - (with-current-buffer buf (buffer-string)) - (kill-buffer buf))))) + (lambda (output) + (let* ((buf (if w-exit-code (nth 1 output) output)) + (buf-str (with-current-buffer buf (buffer-string)))) + (prog1 + (if w-exit-code + (list (nth 0 output) buf-str) + buf-str) + (kill-buffer buf)))))) (setf (deferred-cancel d) (lambda (_x) (deferred:default-cancel d) (deferred:default-cancel pd))) d)) -(defun deferred:process-buffer-gen (f command args) +(defun deferred:process-buffer-gen (f w-exit-code command args) "[internal]" (let ((d (deferred:next)) (uid (deferred:uid))) (let ((proc-name (format "*deferred:*%s*:%s" command uid)) @@ -810,19 +850,22 @@ the command process." 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)))))) + (let ((exit-code (process-exit-status proc))) + (if w-exit-code + (deferred:post-task nd 'ok (list exit-code proc-buf)) + (if (zerop exit-code) + (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) + exit-code + (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 @@ -852,6 +895,26 @@ the command process." `(deferred:nextc ,d (lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args)))) +(defmacro deferred:process-ecc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-ec ,command ,@args)))) + +(defmacro deferred:process-ec-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-ec-buffer ,command ,@args)))) + +(defmacro deferred:process-shell-ecc (d command &rest args) + "Process chain of `deferred:process'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell-ec ,command ,@args)))) + +(defmacro deferred:process-shell-ec-bufferc (d command &rest args) + "Process chain of `deferred:process-buffer'." + `(deferred:nextc ,d + (lambda (,(cl-gensym)) (deferred:process-shell-ec-buffer ,command ,@args)))) + ;; Special variables defined in url-vars.el. (defvar url-request-data) (defvar url-request-method) diff --git a/test/deferred-test.el b/test/deferred-test.el index da91732..f642428 100644 --- a/test/deferred-test.el +++ b/test/deferred-test.el @@ -914,6 +914,24 @@ (nextc it (deferred:not-called-func)) (errorc it (string-match "^Searching for program" (cadr e))))) + (should= + (length (buffer-list)) + (deferred:cancel (deferred:process-ec "pwd" nil)) + (length (buffer-list))) + + (should= 0 + (dtest + (deferred:process-ec "pwd---") + (nextc it (deferred:not-called-func)) + (errorc it (string-match "^Searching for program" (cadr e))))) + + (should= + (with-temp-buffer + (call-process "pwd" nil t nil) + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-ec "pwd" nil))) + (should= (with-temp-buffer (call-process "pwd" nil t nil) (buffer-string)) @@ -921,6 +939,13 @@ (wait 0.1) (deferred:processc it "pwd" nil))) + (should= + (with-temp-buffer (call-process "pwd" nil t nil) + (list 0 (buffer-string))) + (wtest 0.1 + (wait 0.1) + (deferred:process-ecc it "pwd" nil))) + (should= (with-temp-buffer (call-process "ls" nil t "-1") @@ -932,6 +957,32 @@ (error "Not live buffer : %s" x)) (with-current-buffer x (buffer-string))))) + (should= + (with-temp-buffer + (call-process "ls" nil t "-1") + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-ec-buffer "ls" "-1") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (list (nth 0 x) + (with-current-buffer buf (buffer-string))))))) + + (should= + (with-temp-buffer + (call-process "ls" nil t t "--nonsensical") + ;; Matching error output is trickier here, just check exit code. + 2) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-ec-buffer "ls" "--nonsensical") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (nth 0 x))))) + (should= (with-temp-buffer (call-process "ls" nil t "-1") @@ -944,6 +995,20 @@ (error "Not live buffer : %s" x)) (with-current-buffer x (buffer-string))))) + (should= + (with-temp-buffer + (call-process "ls" nil t "-1") + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (wait 0.1) + (deferred:process-ec-bufferc it "ls" "-1") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (list (nth 0 x) + (with-current-buffer buf (buffer-string))))))) + (should= (length (buffer-list)) (deferred:cancel (deferred:process-buffer "ls" nil)) @@ -955,6 +1020,17 @@ (nextc it (deferred:not-called-func)) (errorc it (string-match "^Searching for program" (cadr e))))) + (should= + (length (buffer-list)) + (deferred:cancel (deferred:process-ec-buffer "ls" nil)) + (length (buffer-list))) + + (should= 0 + (dtest + (deferred:process-ec-buffer "pwd---") + (nextc it (deferred:not-called-func)) + (errorc it (string-match "^Searching for program" (cadr e))))) + ;;shell (should= @@ -982,6 +1058,24 @@ (nextc it (deferred:not-called-func)) (errorc it "ERROR"))) + (should= + (length (buffer-list)) + (deferred:cancel (deferred:process-shell-ec "pwd" nil)) + (length (buffer-list))) + + (should= "ERROR" + (wtest 0.1 + (deferred:process-shell-ec "lsasfdsadf") + (nextc it (deferred:not-called-func)) + (errorc it "ERROR"))) + + (should= + (with-temp-buffer + (call-process "pwd" nil t nil) + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-shell-ec "pwd" nil))) + (should= (with-temp-buffer (call-process-shell-command "pwd" nil t nil) (buffer-string)) @@ -989,6 +1083,13 @@ (wait 0.1) (deferred:process-shellc it "pwd" nil))) + (should= + (with-temp-buffer (call-process "pwd" nil t nil) + (list 0 (buffer-string))) + (wtest 0.1 + (wait 0.1) + (deferred:process-shell-ecc it "pwd" nil))) + (should= (with-temp-buffer (call-process-shell-command "ls" nil t "-1") @@ -1000,6 +1101,32 @@ (error "Not live buffer : %s" x)) (with-current-buffer x (buffer-string))))) + (should= + (with-temp-buffer + (call-process "ls" nil t "-1") + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-shell-ec-buffer "ls" "-1") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (list (nth 0 x) + (with-current-buffer buf (buffer-string))))))) + + (should= + (with-temp-buffer + (call-process "ls" nil t t "--nonsensical") + ;; Matching error output is trickier here, just check exit code. + 2) + (wtest 0.1 ;; maybe fail in some environments... + (deferred:process-shell-ec-buffer "ls" "--nonsensical") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (nth 0 x))))) + (should= (with-temp-buffer (call-process-shell-command "ls" nil t "-1") @@ -1012,6 +1139,20 @@ (error "Not live buffer : %s" x)) (with-current-buffer x (buffer-string))))) + (should= + (with-temp-buffer + (call-process "ls" nil t "-1") + (list 0 (buffer-string))) + (wtest 0.1 ;; maybe fail in some environments... + (wait 0.1) + (deferred:process-shell-ec-bufferc it "ls" "-1") + (nextc it + (let ((buf (nth 1 x))) + (unless (buffer-live-p buf) + (error "Not live buffer : %s" buf)) + (list (nth 0 x) + (with-current-buffer buf (buffer-string))))))) + (should= (length (buffer-list)) (deferred:cancel (deferred:process-shell-buffer "ls" nil)) @@ -1021,4 +1162,15 @@ (wtest 0.1 (deferred:process-shell-buffer "lssaf") (nextc it (deferred:not-called-func)) - (errorc it "ERROR")))) + (errorc it "ERROR"))) + + (should= + (length (buffer-list)) + (deferred:cancel (deferred:process-shell-ec-buffer "ls" nil)) + (length (buffer-list))) + + (should= "ERROR" + (wtest 0.1 + (deferred:process-shell-ec-buffer "lssaf") + (nextc it (deferred:not-called-func)) + (errorc it "ERROR"))))