common, fix: use a different way to see if an async process is finished

Fix #150, #163.

citre-common-util.el

@@ -338,6 +338,17 @@ See `citre-make-async-process' for details."
    :documentation
    "Whether the process is a remote one."
    :type "boolean")
+  (status
+   nil
+   :documentation
+   "The status of the process. Could be:
+- `run': The process is running,
+- `success': The process finished successfully.
+- (EXIT-CODE . MSG): The process exits abnormally, with EXIT-CODE
+  being the exit code and MSG being the stderr output (could be
+  an empty string).
+- (`fail' . MSG): The process ends in an abnormal status, with
+  MSG being a string about the status.")
   (-stdout-str
    ""
    :documentation
@@ -409,7 +420,8 @@ for your callback function."
          (proc-data (citre-process-create
                      :callback callback
                      :stderr-buffer stderr-buffer
-                     :remote-p remote-p))
+                     :remote-p remote-p
+                     :status 'run))
          (inhibit-message remote-p)
          (proc
           (make-process
@@ -433,25 +445,37 @@ for your callback function."
                  (if chunk-end
                      (progn
                        (funcall (citre-process-callback proc-data)
-                                'output (concat stdout-cache
-                                                (substring str 0 chunk-end)))
+                                'output
+                                (concat stdout-cache
+                                        (substring str 0 chunk-end)))
                        (setf stdout-cache (substring str chunk-end)))
                    (setf stdout-cache (concat stdout-cache str))))))
            :sentinel
            (lambda (proc _msg)
              (let ((stderr-buffer (citre-process-stderr-buffer proc-data))
                    (callback (citre-process-callback proc-data)))
                (unwind-protect
-                   (pcase (process-status proc)
-                     ('exit
-                      (pcase (process-exit-status proc)
-                        (0 (funcall callback 0 nil))
-                        (s (if (buffer-live-p stderr-buffer)
-                               (funcall callback s
-                                        (with-current-buffer stderr-buffer
-                                          (buffer-string)))
-                             ""))))
-                     (s (funcall callback s nil)))
+                   (progn
+                     (message "Citre: Process sentinel is running.")
+                     (pcase (process-status proc)
+                       ('exit
+                        (pcase (process-exit-status proc)
+                          (0 (setf (citre-process-status proc-data) 'success)
+                             (funcall callback 0 nil))
+                          (s (let ((err (if (buffer-live-p stderr-buffer)
+                                            (with-current-buffer stderr-buffer
+                                              (buffer-string))
+                                          "")))
+                               (setf (citre-process-status proc-data)
+                                     (cons s err))
+                               (funcall callback s err)))))
+                       (s (setf (citre-process-status proc-data)
+                                (cons 'fail (symbol-name s)))
+                          (funcall callback s nil))))
+                 (when (eq (citre-process-status proc-data) 'run)
+                   (setf (citre-process-status proc-data)
+                         (cons 'fail "process sentinel didn't managed to set \
+the process status")))
                  (when (buffer-live-p stderr-buffer)
                    (citre-kill-process-buffer stderr-buffer))))))))
     (setf (citre-process-proc proc-data) proc)
@@ -478,23 +502,10 @@ Keyboard quit is allowed to terminate the process.  When the
 process exits abnormally or run into abnormal status, an error is
 signaled."
   (let* ((result nil)
-         (err-msg nil)
-         (finished nil)
-         (success nil)
          (callback
           (lambda (status msg)
-            (pcase status
-              ('output (setq result
-                             (nconc result (split-string msg "\n" t))))
-              (0 (setq success t))
-              ((and s (pred integerp))
-               (setq err-msg (format "Process %s exits %s:\n%s"
-                                     (car cmd) s msg)))
-              ('signal nil)
-              (s (setq err-msg (format "Abnormal status of process %s:\n%s"
-                                       (car cmd) s))))
-            (unless (eq status 'output)
-              (setq finished t))))
+            (when (eq status 'output)
+              (setq result (nconc result (split-string msg "\n" t))))))
          (proc-data (citre-make-async-process cmd callback))
          (proc (citre-process-proc proc-data)))
     (unwind-protect
@@ -522,20 +533,24 @@ signaled."
           ;; Wait for the process to finish.  This trick is borrowed from
           ;; emacs-aio (https://github.com/skeeto/emacs-aio).  This doesn't
           ;; block.
-          (while (not finished) (accept-process-output))
+          (while (eq (citre-process-status proc-data) 'run)
+            (with-timeout (0.5 nil) (accept-process-output)))
           ;; The process is finished, but there may still be buffered output
-          ;; that's pending, so we `accept-process-output' from the process,
-          ;; and the related stderr pipe process.  This blocks, but doesn't
-          ;; cause a problem, as the process is finished, and the remaining
-          ;; data should be consumed rather quickly.  No need to wait for the
-          ;; stderr pipe process as the error message is already set when the
-          ;; process exits, and in practice this lags popup completion.
-          (when success
-            (while (accept-process-output proc)))
-          (cond
-           (success result)
-           (err-msg (error err-msg))
-           (t nil)))
+          ;; that's pending, so we `accept-process-output' from the process.
+          ;; This blocks, but doesn't cause a problem, as the process is
+          ;; finished, and the remaining data should be consumed rather
+          ;; quickly.  No need to wait for the stderr pipe process as the error
+          ;; message is already set when the process exits, and in practice
+          ;; this lags popup completion.
+          (accept-process-output proc)
+          (pcase (citre-process-status proc-data)
+            ('success nil)
+            (`(,(and (pred integerp) i) . ,msg)
+             (error "Process %s exits %s:\n%s" (car cmd) i msg))
+            (`(fail . ,msg)
+             (error "Invalid FINISH-STATUS: %s" msg))
+            (s (error "Invalid PROCESS-STATUS: %s" s)))
+          result)
       (citre-destruct-process proc-data))))
 
 (provide 'citre-common-util)