# HG changeset patch # User Steve Losh # Date 1608843390 18000 # Node ID 808324313cb6a1677ab94cccea2691a59148021a # Parent 6a9e64a79dd20ef6646ac12bc8ef4264eecfb02d# Parent 65a592d702119a9a746bc66a738847e4abe5ed32 Merge diff -r 65a592d70211 -r 808324313cb6 lisp/batchcolor.lisp --- 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))))))