808324313cb6

Merge
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 24 Dec 2020 15:56:30 -0500
parents 6a9e64a79dd2 (diff) 65a592d70211 (current diff)
children abb473227306 c815c49ae234 b73803334771
branches/tags (none)
files

Changes

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