From ec04757717f79287b62f012fabb7d1c959dc6795 Mon Sep 17 00:00:00 2001
From: Teddy Wing
Date: Tue, 2 Mar 2021 20:41:44 +0100
Subject: main: Exit on Control-c interrupt

Use the `with-user-abort` library to catch an interrupt signal from
`<C-c>` and exit immediately. Otherwise, the Lisp debugger is invoked,
which is not the expected behaviour for a command line program.

Tried putting the `user-abort` condition in the `handler-case` in
`main`, but it didn't appear to be caught in my tests. Decided to catch
it with `handler-case` immediately instead, confirming this works.

Unfortunately, if `<C-c>` is received before entering `main` (by running
the program and immediately pressing it), our handler won't get called,
and instead the Lisp debugger will be invoked. Not sure how to deal with
that, so I've decided not to bother.
---
 src/main.lisp | 48 +++++++++++++++++++++++++++---------------------
 1 file changed, 27 insertions(+), 21 deletions(-)

(limited to 'src/main.lisp')

diff --git a/src/main.lisp b/src/main.lisp
index 01d78a1..d08b323 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -28,27 +28,33 @@
   "Global timeout. The program will exit at the end of this delay.")
 
 (defun main ()
-  (handler-bind ((error #'(lambda (e)
-                            (exit-with-error e sysexits:+unavailable+))))
-
-    ;; Store the config as a global.
-    (defvar *config* (parse-options))
-
-    (trivial-timeout:with-timeout (+timeout-seconds+)
-      (with-websocket-connection ((ws-client *config*))
-        (wsd:on :message (ws-client *config*)
-                #'(lambda (message)
-                    (ws-on-message
-                      message
-                      (extension-ids *config*)
-                      *config*)))
-
-        (websocket-send
-          (ws-client *config*)
-          (target-get-targets-msg
-            (next-call-id *devtools-root-call-id*)))
-
-        (wait-group:wait *wg*)))))
+  (handler-case
+      (interrupt:with-user-abort
+        (handler-bind ((error #'(lambda (e)
+                                  (exit-with-error e sysexits:+unavailable+))))
+
+          ;; Store the config as a global.
+          (defvar *config* (parse-options))
+
+          (trivial-timeout:with-timeout (+timeout-seconds+)
+            (with-websocket-connection ((ws-client *config*))
+              (wsd:on :message (ws-client *config*)
+                      #'(lambda (message)
+                          (ws-on-message
+                            message
+                            (extension-ids *config*)
+                            *config*)))
+
+              (websocket-send
+                (ws-client *config*)
+                (target-get-targets-msg
+                  (next-call-id *devtools-root-call-id*)))
+
+              (wait-group:wait *wg*)))))
+
+    ;; Control-c
+    (interrupt:user-abort ()
+      (opts:exit sysexits:+ok+))))
 
 (defun ws-on-message (message extension-ids config)
   "Called when a WebSocket message is received."
-- 
cgit v1.2.3