branch: elpa/hyperdrive
commit 0589fc245bcfce0954df85f399b1b219477fd053
Author: Adam Porter <[email protected]>
Commit: Joseph Turner <[email protected]>
Refactor: (h//gateway-start-default) Signal an error in fewer cases
---
hyperdrive-lib.el | 53 +++++++++++++++++++++++++++++------------------------
hyperdrive-vars.el | 5 ++++-
hyperdrive.el | 3 +--
3 files changed, 34 insertions(+), 27 deletions(-)
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index c43f061751..b492ff1903 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -1418,32 +1418,37 @@ Then calls THEN if given."
(defun h//gateway-start-default ()
"Start the gateway as an Emacs subprocess.
Default function; see variable `h/gateway-start-function'."
- (cond ((and (h//gateway-ready-p)
+ (cond (h/install-in-progress-p
+ (h/error "Gateway installation in-progress"))
+ ((and (h//gateway-ready-p)
(h/gateway-live-p))
- (h/error "Gateway already running"))
+ (h/message "Gateway already running."))
((h//gateway-ready-p)
- (h/error "Gateway already running outside of Emacs"))
+ (h/message "Gateway already running outside of Emacs."))
((h/gateway-live-p)
- (h/error "Gateway already starting")))
- (let ((hyper-gateway-ushin-path
- (or (h//hyper-gateway-ushin-path)
- (if (yes-or-no-p "hyper-gateway-ushin not installed; install? ")
- (progn
- (declare-function h/install "hyperdrive")
- (h/install))
- (h/error "Gateway not installed; aborted")))))
- (when h/install-in-progress-p
- (h/error "Gateway installation in-progress"))
- (setf h/gateway-process
- (make-process
- :name "hyper-gateway-ushin"
- :buffer " *hyperdrive-start*"
- :command (cons hyper-gateway-ushin-path
- (split-string-and-unquote h/gateway-command-args))
- :connection-type 'pipe))
- ;; TODO: Consider debouncing this function in case the user were to run it
- ;; twice in close succession.
- (h/message "Starting gateway...")))
+ (h/message "Gateway already starting."))
+ (h/gateway-process
+ ;; Process variable is non-nil: gateway might be starting but not yet
+ ;; "live". This probably should never happen, but if it were to, this
+ ;; distinct message might help us understand what's going on.
+ (h/message "Gateway appears to be starting."))
+ (t
+ ;; Start the gateway.
+ (let ((hyper-gateway-ushin-path
+ (or (h//hyper-gateway-ushin-path)
+ (if (yes-or-no-p "hyper-gateway-ushin not installed;
install? ")
+ (progn
+ (declare-function h/install "hyperdrive")
+ (h/install))
+ (h/error "Gateway not installed; aborted")))))
+ (setf h/gateway-process
+ (make-process
+ :name "hyper-gateway-ushin"
+ :buffer " *hyperdrive-start*"
+ :command (cons hyper-gateway-ushin-path
+ (split-string-and-unquote
h/gateway-command-args))
+ :connection-type 'pipe))
+ (h/message "Starting gateway...")))))
(defun h/announce-gateway-ready ()
"Announce that the gateway is ready."
@@ -1510,7 +1515,7 @@ Or if gateway isn't ready within timeout, show an error."
((h//gateway-ready-p)
;; Gateway is responsive, so must be running from outside
Emacs.
(run-hooks 'h/gateway-ready-hook)
- (h/message "Gateway is already running outside of Emacs"))
+ (h/message "Gateway ready (already running outside of
Emacs)"))
((< 10 (float-time (time-subtract nil start-time)))
;; Gateway still not responsive: show error.
(pop-to-buffer " *hyperdrive-start*")
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index c458e8f719..f0c44cfef6 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -408,7 +408,10 @@ Keys are regexps matched against MIME types.")
(declare-function h//gateway-start-default "hyperdrive-lib")
(defcustom h/gateway-start-function #'h//gateway-start-default
- "Function called to start the gateway."
+ "Function called to start the gateway.
+If this function signals an error, the `h/gateway-ready-hook'
+will not be run; otherwise, the hook will be run when the gateway
+appears to be ready."
:type 'function)
(declare-function h//gateway-stop-default "hyperdrive-lib")
diff --git a/hyperdrive.el b/hyperdrive.el
index 8477f3fc72..d84bcb0f4e 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -99,8 +99,7 @@
Calls function set in option `hyperdrive-gateway-start-function',
which see."
(interactive)
- (unless (h//gateway-ready-p)
- (funcall h/gateway-start-function))
+ (funcall h/gateway-start-function)
(h//gateway-wait-for-ready))
;;;###autoload
