--- a/lisp/batchcolor.lisp Wed Dec 23 09:31:53 2020 -0500
+++ b/lisp/batchcolor.lisp Thu Dec 24 15:56:30 2020 -0500
@@ -10,7 +10,11 @@
;;;; Configuration ------------------------------------------------------------
(defparameter *version* "1.0.0")
(defparameter *start* 0)
+(defparameter *dark* t)
+(defparameter *only-matching* nil)
+
+;;;; Colors -------------------------------------------------------------------
(defun rgb-code (r g b)
;; The 256 color mode color values are essentially r/g/b in base 6, but
;; shifted 16 higher to account for the intiial 8+8 colors.
@@ -19,16 +23,18 @@
(* b 1)
16))
-(defparameter *colors*
+(defun make-colors (excludep)
(let ((result (make-array 256 :fill-pointer 0)))
(dotimes (r 6)
(dotimes (g 6)
(dotimes (b 6)
- (unless (< (+ r g b) 3)
- ;; Don't use dark, hard-to-read colors.
+ (unless (funcall excludep (+ r g b))
(vector-push-extend (rgb-code r g b) result)))))
result))
+(defparameter *dark-colors* (make-colors (lambda (v) (< v 3))))
+(defparameter *light-colors* (make-colors (lambda (v) (> v 11))))
+
(defparameter *explicits* (make-hash-table :test #'equal))
@@ -64,8 +70,10 @@
(defun find-color (string)
(gethash string *explicits*
- (aref *colors* (mod (+ (djb2 string) *start*)
- (length *colors*)))))
+ (let ((colors (if *dark* *dark-colors* *light-colors*)))
+ (aref colors
+ (mod (+ (djb2 string) *start*)
+ (length colors))))))
(defun ansi-color-start (color)
(format nil "~C[38;5;~Dm" #\Escape color))
@@ -93,7 +101,8 @@
(print-colorized (subseq line word-start word-end))
(setf start word-end))
starts ends)))
- (write-line line *standard-output* :start start)
+ (unless (and (zerop start) *only-matching*)
+ (write-line line *standard-output* :start start))
(values))
@@ -119,10 +128,11 @@
(defun parse-explicit (spec)
(ppcre:register-groups-bind
((#'parse-integer r g b) string)
- ("([0-5]),([0-5]),([0-5]):(.+)" spec)
+ ("^([0-5]),([0-5]),([0-5]):(.+)$" spec)
(return-from parse-explicit (cons string (rgb-code r g b))))
(error 'malformed-explicit :spec spec))
+
(adopt:defparameters (*option-randomize* *option-no-randomize*)
(adopt:make-boolean-options 'randomize
:help "Randomize the choice of color each run."
@@ -137,6 +147,23 @@
:help "Enable the Lisp debugger."
:help-no "Disable the Lisp debugger (the default)."))
+(adopt:defparameters (*option-dark* *option-light*)
+ (adopt:make-boolean-options 'dark
+ :name-no 'light
+ :long "dark"
+ :long-no "light"
+ :help "Optimize for dark terminals (the default)."
+ :help-no "Optimize for light terminals."
+ :initial-value t))
+
+(adopt:defparameters (*option-only-matching* *option-no-only-matching*)
+ (adopt:make-boolean-options 'only-matching
+ :long "only-matching"
+ :long-no "all-lines"
+ :short #\o
+ :help "Only print lines with at least one match."
+ :help-no "Print all lines, even if they don't have any matches (the default)."))
+
(defparameter *option-explicit*
(adopt:make-option 'explicit
:parameter "R,G,B:STRING"
@@ -174,13 +201,16 @@
highlighted. Overlapping capturing groups are not supported.")
(adopt:define-string *extra-manual-text*
- "Overlapping capturing groups are not supported because it's not clear what ~
- the result should be. For example: what should ((f)oo|(b)oo) highlight when ~
- matched against 'foo'? Should it highlight 'foo' in one color? The 'f' in ~
- one color and 'oo' in another color? Should that 'oo' be the same color as ~
- the 'oo' in 'boo' even though the overall match was different? There are too ~
- many possible behaviors and no clear winner, so batchcolor disallows ~
- overlapping capturing groups entirely.")
+ "If no FILEs are given, standard input will be used. A file of - stands for ~
+ standard input as well.~@
+ ~@
+ Overlapping capturing groups are not supported because it's not clear what ~
+ the result should be. For example: what should ((f)oo|(b)oo) highlight when ~
+ matched against 'foo'? Should it highlight 'foo' in one color? The 'f' in ~
+ one color and 'oo' in another color? Should that 'oo' be the same color as ~
+ the 'oo' in 'boo' even though the overall match was different? There are too ~
+ many possible behaviors and no clear winner, so batchcolor disallows ~
+ overlapping capturing groups entirely.")
(defparameter *examples*
'(("Colorize IRC nicknames in a chat log:"
@@ -188,7 +218,9 @@
("Colorize UUIDs in a request log:"
. "tail -f /var/log/foo | batchcolor '[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}'")
("Colorize some keywords explicitly and IPv4 addresses randomly (note that the keywords have to be in the main regex too, not just in the -e options):"
- . "batchcolor 'WARN|INFO|ERR|(?:[0-9]{1,3}\\\\.){3}[0-9]{1,3}' -e '5,0,0:ERR' -e '5,4,0:WARN' -e '2,2,5:INFO'")))
+ . "batchcolor 'WARN|INFO|ERR|(?:[0-9]{1,3}\\\\.){3}[0-9]{1,3}' -e '5,0,0:ERR' -e '5,4,0:WARN' -e '2,2,5:INFO' foo.log")
+ ("Colorize earmuffed symbols in a Lisp file, only printing lines with at least one such symbol:"
+ . "batchcolor --only-matching '(?:^|[^*])([*][-a-zA-Z0-9]+[*])(?:$|[^*])' tests/test.lisp")))
(defparameter *ui*
@@ -199,19 +231,37 @@
:help *help-text*
:manual (concatenate 'string *help-text* (format nil "~2%") *extra-manual-text*)
:examples *examples*
- :contents (list *option-randomize*
- *option-no-randomize*
- *option-explicit*
- *option-debug*
- *option-no-debug*
- *option-help*
- *option-version*)))
+ :contents (list
+ *option-help*
+ *option-version*
+ *option-debug*
+ *option-no-debug*
+ (adopt:make-group 'color-options
+ :title "Color Options"
+ :options (list *option-randomize*
+ *option-no-randomize*
+ *option-dark*
+ *option-light*
+ *option-explicit*))
+ (adopt:make-group 'output-options
+ :title "Output Options"
+ :options (list *option-only-matching*
+ *option-no-only-matching*)))))
(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 configure (options)
+ (loop :for (string . rgb) :in (gethash 'explicit options)
+ :do (setf (gethash string *explicits*) rgb))
+ (setf *start* (if (gethash 'randomize options)
+ (random 256 (make-random-state t))
+ 0)
+ *dark* (gethash 'dark options)
+ *only-matching* (gethash 'only-matching options)))
+
(defun toplevel ()
(sb-ext:disable-debugger)
(exit-on-ctrl-c
@@ -224,11 +274,7 @@
((gethash 'version options) (write-line *version*) (adopt:exit))
((null arguments) (error 'missing-regex))
(t (destructuring-bind (pattern . files) arguments
- (loop :for (string . rgb) :in (gethash 'explicit options)
- :do (setf (gethash string *explicits*) rgb))
- (let ((*start* (if (gethash 'randomize options)
- (random 256 (make-random-state t))
- 0)))
- (run pattern files)))))
+ (configure options)
+ (run pattern files))))
(user-error (e) (adopt:print-error-and-exit e))))))