# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1575489188 18000
# Node ID ad3a9d70d78cb55856902a4566fc1ac31df371d4
# Parent  9ab8e17039d66e710295a90ab5af24ed6afe196b
w-u-a

diff -r 9ab8e17039d6 -r ad3a9d70d78c lisp/batchcolor.lisp
--- a/lisp/batchcolor.lisp	Wed Dec 04 14:42:30 2019 -0500
+++ b/lisp/batchcolor.lisp	Wed Dec 04 14:53:08 2019 -0500
@@ -1,5 +1,5 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload '(:adopt :cl-ppcre) :silent t))
+  (ql:quickload '(:adopt :cl-ppcre :with-user-abort) :silent t))
 
 (defpackage :batchcolor
   (:use :cl)
@@ -153,42 +153,21 @@
                     *option-version*)))
 
 
-(defmacro quit-on-ctrl-c (&body body)
-  `(handler-case
-     (progn ,@body)
-     #+sbcl (sb-sys:interactive-interrupt (c)
-               (declare (ignore c))
-               (adopt:exit))))
-
-(defmacro maybe-die-on-errors (should-die &body body)
-  `(if ,should-die
-     (handler-case (progn ,@body)
-       (error (c) (adopt:print-error-and-exit c)))
-     (progn
-       #+sbcl (sb-ext:enable-debugger)
-       ,@body)))
-
-(defun parse-options-or-exit (ui)
-  (handler-case (adopt:parse-options ui)
+(defun toplevel ()
+  #+sbcl (sb-ext:disable-debugger)
+  (handler-case
+      (with-user-abort:with-user-abort
+        (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
+          (cond
+            ((gethash 'help options) (adopt:print-help-and-exit *ui*))
+            ((gethash 'version options) (write-line *version*) (adopt:exit))
+            (t (if (< (length arguments) 1)
+                 (adopt:print-help-and-exit *ui*)
+                 (destructuring-bind (pattern . files) arguments
+                   (let ((*start* (if (gethash 'randomize options)
+                                    (random 256 (make-random-state t))
+                                    0)))
+                     (run pattern files))))))))
+    (with-user-abort:user-abort () (adopt:exit 130))
     (error (c) (adopt:print-error-and-exit c))))
 
-
-(defun toplevel (&aux arguments options)
-  #+sbcl (sb-ext:disable-debugger)
-  (quit-on-ctrl-c
-    (setf (values arguments options)
-          (parse-options-or-exit *ui*))
-    (maybe-die-on-errors (not (gethash 'debug options))
-      (when (gethash 'help options)
-        (adopt:print-help-and-exit *ui*))
-      (when (gethash 'version options)
-        (write-line *version*)
-        (adopt:exit))
-      (if (< (length arguments) 1)
-        (adopt:print-help-and-exit *ui*)
-        (destructuring-bind (pattern . files) arguments
-          (let ((*start* (if (gethash 'randomize options)
-                           (random 256 (make-random-state t))
-                           0)))
-            (run pattern files)))))))
-
diff -r 9ab8e17039d6 -r ad3a9d70d78c lisp/retry.lisp
--- a/lisp/retry.lisp	Wed Dec 04 14:42:30 2019 -0500
+++ b/lisp/retry.lisp	Wed Dec 04 14:53:08 2019 -0500
@@ -1,6 +1,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload '(:adopt :iterate :external-program :parse-number :alexandria)
-                :silent t))
+  (ql:quickload
+    '(:adopt :iterate :external-program :parse-number :alexandria :with-user-abort)
+    :silent t))
 
 (defpackage :retry
   (:use :cl :iterate)
@@ -187,12 +188,6 @@
                 *option-version*)))
 
 
-(defmacro quit-on-ctrl-c (&body body)
-  `(handler-case
-     (progn ,@body)
-     #+sbcl (sb-sys:interactive-interrupt (c)
-               (declare (ignore c))
-               (adopt:exit 130))))
 
 (defun parse-options-or-exit (ui)
   (handler-case (adopt:parse-options ui)
@@ -201,11 +196,13 @@
 
 (defun toplevel ()
   #+sbcl (sb-ext:disable-debugger)
-  (quit-on-ctrl-c
-    (multiple-value-bind (arguments options)
-        (parse-options-or-exit *ui*)
-      (cond
-        ((gethash 'help options) (adopt:print-help-and-exit *ui*))
-        ((gethash 'version options) (write-line *version*) (adopt:exit))
-        (t (adopt:exit (run arguments options)))))))
+  (handler-case
+      (with-user-abort:with-user-abort
+        (multiple-value-bind (arguments options)
+            (parse-options-or-exit *ui*)
+          (cond
+            ((gethash 'help options) (adopt:print-help-and-exit *ui*))
+            ((gethash 'version options) (write-line *version*) (adopt:exit))
+            (t (adopt:exit (run arguments options))))))
+    (with-user-abort:user-abort () (adopt:exit 130))))
 
diff -r 9ab8e17039d6 -r ad3a9d70d78c lisp/search.lisp
--- a/lisp/search.lisp	Wed Dec 04 14:42:30 2019 -0500
+++ b/lisp/search.lisp	Wed Dec 04 14:53:08 2019 -0500
@@ -1,5 +1,5 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload '(:adopt :cl-ppcre) :silent t))
+  (ql:quickload '(:adopt :cl-ppcre :with-user-abort) :silent t))
 
 (defpackage :search
   (:use :cl)
@@ -86,13 +86,15 @@
 
 (defun toplevel ()
   (handler-case
-      (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
-        (when (gethash 'help options)
-          (adopt:print-help-and-exit *ui*))
-        (when (null arguments)
-          (error "PATTERN is required"))
-        (destructuring-bind (pattern . paths) arguments
-          (run pattern (or paths (list "-"))
-               :literal (gethash 'literal options)
-               :invert (gethash 'invert options))))
+      (with-user-abort:with-user-abort
+        (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
+          (when (gethash 'help options)
+            (adopt:print-help-and-exit *ui*))
+          (when (null arguments)
+            (error "PATTERN is required"))
+          (destructuring-bind (pattern . paths) arguments
+            (run pattern (or paths (list "-"))
+                 :literal (gethash 'literal options)
+                 :invert (gethash 'invert options)))))
+    (with-user-abort:user-abort () (adopt:exit 130))
     (error (c) (adopt:print-error-and-exit c))))