[nongnu] elpa/hyperdrive 4d10e5584b 25/26: WIP: (hyperdrive--gateway-stop-default) Make asynchronous

[ELPA Syncer]

branch: elpa/hyperdrive
commit 4d10e5584b4808f1aca070a115a663e276beb69a
Author: Joseph Turner <joseph@ushin.org>
Commit: Adam Porter <adam@alphapapa.net>

    WIP: (hyperdrive--gateway-stop-default) Make asynchronous
---
 hyperdrive-lib.el  | 31 +++++++++++++++++++++++++++++++
 hyperdrive-vars.el | 11 +++++++++++
 hyperdrive.el      |  3 ++-
 3 files changed, 44 insertions(+), 1 deletion(-)

diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index ebd2455afc..78309bf03b 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -1530,6 +1530,10 @@ Default function; see variable 
`h/gateway-start-function'."
   "Announce that the gateway is ready."
   (h/message "Gateway ready."))
 
+(defun h/announce-gateway-stopped ()
+  "Announce that the gateway is stopped."
+  (h/message "Gateway stopped."))
+
 (defun h/menu-refresh ()
   "Refresh `hyperdrive-menu' if it's open."
   (when (transient-active-prefix '(h/menu))
@@ -1550,6 +1554,33 @@ Default function; see variable 
`h/gateway-start-function'."
     (cancel-timer h//gateway-starting-timer))
   (h/message "Gateway stopped."))
 
+(defun h//gateway-wait-for-dead ()
+  "Run `hyperdrive-gateway-dead-hook' after the gateway is dead.
+Or if gateway isn't dead within timeout, show an error."
+  (letrec
+      ((start-time (current-time))
+       (check
+        (lambda ()
+          (cond ((not (h/gateway-live-p))
+                 (run-hooks 'h/gateway-dead-hook)
+                 (when (timerp h//gateway-starting-timer)
+                   (cancel-timer h//gateway-starting-timer)))
+                ((< 10 (float-time (time-subtract nil start-time)))
+                 ;; Gateway still not responsive: show error.
+                 (if-let (((equal h/gateway-stop-function
+                                  (eval (car (get 'h/gateway-stop-function
+                                                  'standard-value)))))
+                          (process-buffer (process-buffer h/gateway-process)))
+                     ;; User has not customized the start function: suggest
+                     ;; opening the process buffer.
+                     (h/error "Gateway failed to stop (see %S for errors)"
+                              process-buffer)
+                   ;; User appears to have customized the start function.
+                   (h/error "Gateway failed to stop")))
+                (t
+                 (setf h//gateway-stopping-timer (run-at-time 0.1 nil 
check)))))))
+    (funcall check)))
+
 (defun h/gateway-live-p ()
   "Return non-nil if the gateway process is running.
 Calls function set in option `hyperdrive-gateway-live-predicate'.
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 6611fab900..645a3f25e0 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -406,6 +406,9 @@ If the version was unexpected,
 (defvar h//gateway-starting-timer nil
   "The timer used when the gateway is starting.")
 
+(defvar h//gateway-stopping-timer nil
+  "The timer used when the gateway is stopping.")
+
 (defvar-local h/current-entry nil
   "Entry for current buffer.")
 (put 'h/current-entry 'permanent-local t)
@@ -465,6 +468,14 @@ This hook is called by 
`hyperdrive--gateway-wait-for-ready' after
 `hyperdrive-start'."
   :type 'hook)
 
+(defcustom h/gateway-dead-hook
+  '( h/announce-gateway-stopped
+     h/menu-refresh)
+  "Hook called when gateway is ready after starting it.
+This hook is called by `hyperdrive--gateway-wait-for-ready' after
+`hyperdrive-start'."
+  :type 'hook)
+
 ;;;; Footer
 
 (provide 'hyperdrive-vars)
diff --git a/hyperdrive.el b/hyperdrive.el
index 76552b2d45..6f3463c652 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -120,7 +120,8 @@ which see."
 Calls function set in option `hyperdrive-gateway-stop-function',
 which see."
   (interactive)
-  (funcall h/gateway-stop-function))
+  (funcall h/gateway-stop-function)
+  (h//gateway-wait-for-dead))
 
 ;;;###autoload
 (defun hyperdrive-gateway-version ()