--- 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)))))))
-
--- 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))))
--- 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))))