[elpa] externals/plz 46d0c54525 01/13: WIP

[ELPA Syncer]

branch: externals/plz
commit 46d0c54525a8d598960162d2717aecbab3d85b03
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    WIP
    
    See https://github.com/alphapapa/plz.el/issues/53.
---
 plz.el | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 128 insertions(+), 36 deletions(-)

diff --git a/plz.el b/plz.el
index f75168c935..09a81af820 100644
--- a/plz.el
+++ b/plz.el
@@ -250,6 +250,70 @@ connection phase and waiting to receive the response (the
 \"--max-time\" argument to curl)."
   :type 'number)
 
+;;;; Macros
+
+(require 'warnings)
+
+(cl-defmacro plz-debug (&rest args)
+  ;; Copied from `ement-debug' in Ement.el, which see.
+  "Display a debug warning showing the runtime value of ARGS.
+The warning automatically includes the name of the containing
+function, and it is only displayed if `warning-minimum-log-level'
+is `:debug' at expansion time (otherwise the macro expands to a
+call to `ignore' with ARGS and is eliminated by the
+byte-compiler).  When debugging, the form also returns nil so,
+e.g. it may be used in a conditional in place of nil.
+
+Each of ARGS may be a string, which is displayed as-is, or a
+symbol, the value of which is displayed prefixed by its name, or
+a Lisp form, which is displayed prefixed by its first symbol.
+
+Before the actual ARGS arguments, you can write keyword
+arguments, i.e. alternating keywords and values.  The following
+keywords are supported:
+
+  :buffer BUFFER   Name of buffer to pass to `display-warning'.
+  :level  LEVEL    Level passed to `display-warning', which see.
+                   Default is :debug."
+  ;; TODO: Can we use a compiler macro to handle this more elegantly?
+  (pcase-let* ((fn-name (when byte-compile-current-buffer
+                          (with-current-buffer byte-compile-current-buffer
+                            ;; This is a hack, but a nifty one.
+                            (save-excursion
+                              (beginning-of-defun)
+                              (cl-second (read (current-buffer)))))))
+               (plist-args (cl-loop while (keywordp (car args))
+                                    collect (pop args)
+                                    collect (pop args)))
+               ((map (:buffer buffer) (:level level)) plist-args)
+               (level (or level :debug))
+               (string (cl-loop for arg in args
+                                concat (pcase arg
+                                         ((pred stringp) "%S ")
+                                         ((pred symbolp)
+                                          (concat (upcase (symbol-name arg)) 
":%S "))
+                                         ((pred listp)
+                                          (concat "(" (upcase (symbol-name 
(car arg)))
+                                                  (pcase (length arg)
+                                                    (1 ")")
+                                                    (_ "...)"))
+                                                  ":%S "))))))
+    (if (eq :debug warning-minimum-log-level)
+        `(let ((fn-name ,(if fn-name
+                             `',fn-name
+                           ;; In an interpreted function: use 
`backtrace-frame' to get the
+                           ;; function name (we have to use a little hackery 
to figure out
+                           ;; how far up the frame to look, but this seems to 
work).
+                           `(cl-loop for frame in (backtrace-frames)
+                                     for fn = (cl-second frame)
+                                     when (not (or (subrp fn)
+                                                   (special-form-p fn)
+                                                   (eq 'backtrace-frames fn)))
+                                     return (make-symbol (format "%s 
[interpreted]" fn))))))
+           (display-warning fn-name (format ,string ,@args) ,level ,buffer)
+           nil)
+      `(ignore ,@args))))
+
 ;;;; Functions
 
 ;;;;; Public
@@ -518,15 +582,19 @@ into the process buffer.
                 (error "Process unexpectedly nil"))
               (while (accept-process-output process))
               (while (accept-process-output stderr-process))
+              (plz-debug (float-time) "BEFORE HACK" (process-buffer process))
               (when (eq :plz-result (process-get process :plz-result))
+                (plz-debug (float-time) "INSIDE HACK" (process-buffer process))
                 ;; HACK: Sentinel seems to not have been called: call it 
again.  (Although
                 ;; this is a hack, it seems to be a necessary one due to 
Emacs's process
                 ;; handling.)  See 
<https://github.com/alphapapa/plz.el/issues/3> and
                 ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=50166>.
-                (plz--sentinel process "finished\n")
+                (plz--sentinel process "workaround")
+                (plz-debug (float-time) "INSIDE HACK, AFTER CALLING SENTINEL" 
(process-buffer process))
                 (when (eq :plz-result (process-get process :plz-result))
                   (error "Plz: NO RESULT FROM PROCESS:%S  ARGS:%S"
                          process rest)))
+              (plz-debug (float-time) "AFTER HACK" (process-buffer process))
               ;; Sentinel seems to have been called: check the result.
               (pcase (process-get process :plz-result)
                 ((and (pred plz-error-p) data)
@@ -740,14 +808,28 @@ STATUS should be the process's event string (see info
 node `(elisp) Sentinels').  Calls `plz--respond' to process the
 HTTP response (directly for synchronous requests, or from a timer
 for asynchronous ones)."
-  (pcase status
-    ((or "finished\n" "killed\n" "interrupt\n"
-         (pred numberp)
-         (rx "exited abnormally with code " (group (1+ digit))))
-     (let ((buffer (process-buffer process)))
-       (if (process-get process :plz-sync)
-           (plz--respond process buffer status)
-         (run-at-time 0 nil #'plz--respond process buffer status))))))
+  (plz-debug (float-time) "BEFORE CONDITION"
+             process status (process-get process :plz-result))
+  (if (eq :plz-result (process-get process :plz-result))
+      ;; Result not yet set: call `plz--respond'.
+      (if (member (process-status process) '(run stop))
+          (plz-debug "Doing nothing because:" (process-status process))
+        ;; Process should have exited (otherwise we should do
+        ;; nothing).  We check `process-status' because the STATUS
+        ;; variable might not be accurate (see "hack" in `plz').
+        (pcase status
+          ((or "finished\n" "killed\n" "interrupt\n" "workaround"
+               (pred numberp)
+               (rx "exited abnormally with code " (group (1+ digit))))
+           (let ((buffer (process-buffer process)))
+             (if (process-get process :plz-sync)
+                 (plz--respond process buffer status)
+               (run-at-time 0 nil #'plz--respond process buffer status))))))
+    ;; Result already set (likely indicating that Emacs did not call
+    ;; the sentinel when `accept-process-output' was called, so we are
+    ;; calling it from our "hack"): do nothing.
+    (plz-debug (float-time) ":PLZ-RESULT ALREADY CHANGED"
+               process status (process-get process :plz-result))))
 
 (defun plz--respond (process buffer status)
   "Respond to HTTP response from PROCESS in BUFFER.
@@ -760,11 +842,14 @@ argument passed to `plz--sentinel', which see."
   ;; "Respond" also means "to react to something," which is what this
   ;; does--react to receiving the HTTP response--and it's an internal
   ;; name, so why not.
+  (plz-debug (float-time) process status (process-status process) buffer)
   (unwind-protect
-      (with-current-buffer buffer
-        (pcase-exhaustive status
-          ((or 0 "finished\n")
-           ;; Curl exited normally: check HTTP status code.
+      (pcase-exhaustive (process-exit-status process)
+        (0
+         ;; Curl exited normally: check HTTP status code.
+         (with-current-buffer buffer
+           ;; NOTE: We only switch to the process's buffer if curl
+           ;; exited successfully.
            (goto-char (point-min))
            (plz--skip-proxy-headers)
            (while (plz--skip-redirect-headers))
@@ -784,29 +869,36 @@ argument passed to `plz--sentinel', which see."
               (let ((err (make-plz-error :response (plz--response))))
                 (pcase-exhaustive (process-get process :plz-else)
                   (`nil (process-put process :plz-result err))
-                  ((and (pred functionp) fn) (funcall fn err)))))))
-
-          ((or (and (pred numberp) code)
-               (rx "exited abnormally with code " (let code (group (1+ 
digit)))))
-           ;; Curl error.
-           (let* ((curl-exit-code (cl-typecase code
-                                    (string (string-to-number code))
-                                    (number code)))
-                  (curl-error-message (alist-get curl-exit-code 
plz-curl-errors))
-                  (err (make-plz-error :curl-error (cons curl-exit-code 
curl-error-message))))
-             (pcase-exhaustive (process-get process :plz-else)
-               (`nil (process-put process :plz-result err))
-               ((and (pred functionp) fn) (funcall fn err)))))
-
-          ((and (or "killed\n" "interrupt\n") status)
-           ;; Curl process killed or interrupted.
-           (let* ((message (pcase status
-                             ("killed\n" "curl process killed")
-                             ("interrupt\n" "curl process interrupted")))
-                  (err (make-plz-error :message message)))
-             (pcase-exhaustive (process-get process :plz-else)
-               (`nil (process-put process :plz-result err))
-               ((and (pred functionp) fn) (funcall fn err)))))))
+                  ((and (pred functionp) fn) (funcall fn err))))))))
+        ((and code (guard (<= 1 code 90)))
+         ;; Curl exited non-zero.
+         (let* ((curl-exit-code (cl-typecase code
+                                  (string (string-to-number code))
+                                  (number code)))
+                (curl-error-message (alist-get curl-exit-code plz-curl-errors))
+                (err (make-plz-error :curl-error (cons curl-exit-code 
curl-error-message))))
+           (pcase-exhaustive (process-get process :plz-else)
+             (`nil (process-put process :plz-result err))
+             ((and (pred functionp) fn) (funcall fn err)))))
+        ((and code (guard (not (<= 1 code 90))))
+         ;; If we are here, it should mean that the curl process was
+         ;; killed or interrupted, and the code should be something
+         ;; not (<= 1 code 90).
+         (let* ((message (pcase status
+                           ("killed\n" "curl process killed")
+                           ("interrupt\n" "curl process interrupted")
+                           (_ (format "Unexpected curl process status:%S 
code:%S.  Please report this bug to the `plz' maintainer." status code))))
+                (err (make-plz-error :message message)))
+           (pcase-exhaustive (process-get process :plz-else)
+             (`nil (process-put process :plz-result err))
+             ((and (pred functionp) fn) (funcall fn err)))))
+        (code
+         ;; If we are here, something is really wrong.
+         (let* ((message (format "Unexpected curl process status:%S code:%S.  
Please report this bug to the `plz' maintainer." status code))
+                (err (make-plz-error :message message)))
+           (pcase-exhaustive (process-get process :plz-else)
+             (`nil (process-put process :plz-result err))
+             ((and (pred functionp) fn) (funcall fn err))))))
     (when-let ((finally (process-get process :plz-finally)))
       (funcall finally))
     (unless (or (process-get process :plz-sync)