# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1578380200 28800
# Node ID ebc3de26327155ca31a787d7168c4594b9ba7cd5
# Parent  430034d109813ce36cf6b78659b28dc3b3a470c9
Dick around with batchcolor a bit more

diff -r 430034d10981 -r ebc3de263271 lisp/.lispwords
--- a/lisp/.lispwords	Mon Jan 06 17:03:06 2020 -0800
+++ b/lisp/.lispwords	Mon Jan 06 22:56:40 2020 -0800
@@ -1,1 +1,2 @@
 (1 maybe-die-on-errors)
+(1 exit-on-error-unless)
diff -r 430034d10981 -r ebc3de263271 lisp/batchcolor.lisp
--- a/lisp/batchcolor.lisp	Mon Jan 06 17:03:06 2020 -0800
+++ b/lisp/batchcolor.lisp	Mon Jan 06 22:56:40 2020 -0800
@@ -30,6 +30,13 @@
 
 
 ;;;; Functionality ------------------------------------------------------------
+(define-condition bad-regex (error) ()
+  (:report "Invalid regex."))
+
+(define-condition bad-regex-group-count (bad-regex) ()
+  (:report "Invalid regex: must contain exactly 1 register group, e.g. 'x (fo+) y'."))
+
+
 (defun djb2 (string)
   ;; http://www.cse.yorku.ca/~oz/hash.html
   (reduce (lambda (hash c)
@@ -53,7 +60,7 @@
     (setf rs (remove nil rs)
           re (remove nil re))
     (when (/= 1 (length rs))
-      (error "Regex must contain exactly 1 register group, e.g. 'x (fo+) y'."))
+      (error 'bad-regex-group-count))
     (let* ((word-start (aref rs 0))
            (word-end (aref re 0))
            (word (subseq line word-start word-end))
@@ -68,7 +75,15 @@
 ;;;; Run ----------------------------------------------------------------------
 (defun run% (scanner stream)
   (loop :for line = (read-line stream nil)
-        :while line :do (colorize-line scanner line)))
+        :while line
+        :do (tagbody retry
+              (restart-case (colorize-line scanner line)
+                (supply-new-regex (v)
+                    :test (lambda (c) (typep c 'bad-regex))
+                    :report "Supply a new regular expression as a string."
+                    :interactive (lambda () (list (read-line *query-io*)))
+                  (setf scanner (ppcre:create-scanner v))
+                  (go retry))))))
 
 (defun run (pattern paths)
   (if (null paths)
@@ -153,21 +168,41 @@
                     *option-version*)))
 
 
+(defmacro without-debugger (&body body)
+  `(multiple-value-prog1
+     (progn
+       #+sbcl (sb-ext:disable-debugger)
+       (progn ,@body))
+     (progn
+       #+sbcl (sb-ext:enable-debugger))))
+
+(defmacro exit-on-error (&body body)
+  `(without-debugger
+     (handler-case (progn ,@body)
+       (error (c) (adopt:print-error-and-exit c)))))
+
+(defmacro exit-on-error-unless (expr &body body)
+  `(if ,expr
+       (progn ,@body)
+     (exit-on-error ,@body)))
+
+(defmacro exit-on-ctrl-c (&body body)
+  `(handler-case
+       (with-user-abort:with-user-abort (progn ,@body))
+     (with-user-abort:user-abort () (adopt:exit 130))))
+
+
 (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))))
+  (exit-on-ctrl-c
+    (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*)
+      (exit-on-error-unless (gethash 'debug options)
+        (cond
+          ((gethash 'help options) (adopt:print-help-and-exit *ui*))
+          ((gethash 'version options) (write-line *version*) (adopt:exit))
+          ((null arguments) (error "A regular expression is required."))
+          (t (destructuring-bind (pattern . files) arguments
+               (let ((*start* (if (gethash 'randomize options)
+                                (random 256 (make-random-state t))
+                                0)))
+                 (run pattern files)))))))))