@@ -20,3 +20,4 @@

 core

 pom.xml

 pom.xml.asc

+/tools/bin/zenburn

@@ -1,9 +1,17 @@

-all: git-pick-patch bloomutil

+all: bin bin/git-pick-patch bin/bloomutil bin/zenburn

-bindir:

+bin/zenburn: zenburn.lisp

+	sbcl --lose-on-corruption --disable-ldb --disable-debugger \

+		  --no-userinit --no-sysinit \

+		  --eval '(push :fw.dump *features*)' \

+		  --load zenburn.lisp \

+		  --eval '(fwoar.zenburn:dump)'

+	mv zenburn bin

+

+bin:

 	mkdir -p bin

-bloomutil: bloomutil.lisp

+bin/bloomutil: bloomutil.lisp

 	sbcl --disable-debugger \

 	     --no-userinit \

 	     --eval '(pushnew :fw.dump *features*)' \

@@ -11,7 +19,7 @@ bloomutil: bloomutil.lisp

 	     --eval '(fwoar.bloomutil::dump)'

 	mv bloomutil bin

-git-pick-patch: bindir git-pick-patch.lisp

+bin/git-pick-patch: git-pick-patch.lisp

 	sbcl --eval "(ql:quickload '(:alexandria :serapeum :cl-ppcre))" \

 	     --load git-pick-patch.lisp \

 	     --eval '(save-lisp-and-die "bin/git-pick-patch"'" :executable t :toplevel 'git-pick-patch::main :compression t)"

new file mode 100644

@@ -0,0 +1,149 @@

+#+fw.dump

+(eval-when (:compile-toplevel :load-toplevel :execute)

+  (load "~/quicklisp/setup.lisp")

+  (require :uiop))

+

+#+fw.dump

+(ql:quickload '(:net.didierverna.clon))

+

+(defpackage :fwoar.zenburn

+  (:use :cl )

+  (:export dump))

+(in-package :fwoar.zenburn)

+

+(defun 256-color-text (fg bg format &rest args)

+  (cond ((and fg bg)

+         (destructuring-bind (fg-r fg-g fg-b) fg

+           (destructuring-bind (bg-r bg-g bg-b) bg

+             (format T "~c[38;2;~d;~d;~d;48;2;~d;~d;~dm~?~@*~c[39m~:*~c[49m"

+                     #\Esc

+                     fg-r fg-g fg-b

+                     bg-r bg-g bg-b

+                     format

+                     args))))

+        (fg

+         (destructuring-bind (fg-r fg-g fg-b) fg

+           (format T "~c[38;2;~d;~d;~dm~?~@*~c[39m~:*~c[49m"

+                   #\Esc

+                   fg-r fg-g fg-b

+                   format

+                   args)))

+        (bg

+         (destructuring-bind (bg-r bg-g bg-b) bg

+           (format T "~c[48;2;~d;~d;~dm~?~@*~c[39m~:*~c[49m"

+                   #\Esc

+                   bg-r bg-g bg-b

+                   format

+                   args)))

+        (t (error "must specify either fg or bg for a color"))))

+

+(defparameter color-alist

+  '((fg+2     . (#xFF #xFF #xEF))

+    (fg+1     . (#xF5 #xF5 #xD6))

+    (fg       . (#xDC #xDC #xCC))

+    (fg-1     . (#xA6 #xA6 #x89))

+    (fg-2     . (#x65 #x65 #x55))

+    (black    . (#x00 #x00 #x00))

+    (bg-2     . (#x00 #x00 #x00))

+    (bg-1     . (#x11 #x11 #x12))

+    (bg-05    . (#x38 #x38 #x38))

+    (bg       . (#x2A #x2B #x2E))

+    (bg+05    . (#x49 #x49 #x49))

+    (bg+1     . (#x4F #x4F #x4F))

+    (bg+2     . (#x5F #x5F #x5F))

+    (bg+3     . (#x6F #x6F #x6F))

+    (red+2    . (#xEC #xB3 #xB3))

+    (red+1    . (#xDC #xA3 #xA3))

+    (red      . (#xCC #x93 #x93))

+    (red-1    . (#xBC #x83 #x83))

+    (red-2    . (#xAC #x73 #x73))

+    (red-3    . (#x9C #x63 #x63))

+    (red-4    . (#x8C #x53 #x53))

+    (red-5    . (#x7C #x43 #x43))

+    (red-6    . (#x6C #x33 #x33))

+    (orange   . (#xDF #xAF #x8F))

+    (yellow   . (#xF0 #xDF #xAF))

+    (yellow-1 . (#xE0 #xCF #x9F))

+    (yellow-2 . (#xD0 #xBF #x8F))

+    (green-5  . (#x2F #x4F #x2F))

+    (green-4  . (#x3F #x5F #x3F))

+    (green-3  . (#x4F #x6F #x4F))

+    (green-2  . (#x5F #x7F #x5F))

+    (green-1  . (#x6F #x8F #x6F))

+    (green    . (#x7F #x9F #x7F))

+    (green+1  . (#x8F #xB2 #x8F))

+    (green+2  . (#x9F #xC5 #x9F))

+    (green+3  . (#xAF #xD8 #xAF))

+    (green+4  . (#xBF #xEB #xBF))

+    (cyan     . (#x93 #xE0 #xE3))

+    (blue+3   . (#xBD #xE0 #xF3))

+    (blue+2   . (#xAC #xE0 #xE3))

+    (blue+1   . (#x94 #xBF #xF3))

+    (blue     . (#x8C #xD0 #xD3))

+    (blue-1   . (#x7C #xB8 #xBB))

+    (blue-2   . (#x6C #xA0 #xA3))

+    (blue-3   . (#x5C #x88 #x8B))

+    (blue-4   . (#x4C #x70 #x73))

+    (blue-5   . (#x36 #x60 #x60))

+    (magenta  . (#xDC #x8C #xC3))))

+

+(defun zenburn-text (fg bg text &rest format-args)

+  (let ((fgcolor (when fg (cdr (assoc fg color-alist :test 'equal))))

+        (bgcolor (when bg (cdr (assoc bg color-alist :test 'equal)))))

+    (apply #'256-color-text fgcolor bgcolor text format-args)))

+

+(defun summary ()

+  (loop for (color . values) in color-alist

+        do

+           (zenburn-text () color (make-string 32 :initial-element #\space))

+           (format t "  ~8<~a~> (~{~2x~^, ~}) ~:* (~{~3d~^, ~})~%" color values)))

+

+(defvar *synopsis*

+  (net.didierverna.clon:defsynopsis (:postfix "[TEXT...]" :make-default nil)

+    (flag :short-name "h" :long-name "help")

+    (enum :short-name "f" :long-name "fg" :enum (mapcar 'car color-alist)

+          :description "Set the text's foreground color")

+    (enum :short-name "b" :long-name "bg" :enum (mapcar 'car color-alist)

+          :description "Set the text's background color")

+    (enum :long-name "html"  :enum (mapcar 'car color-alist)

+          :description "Show COLOR as an HTML RGB literal")

+    (enum :long-name "css"  :enum (mapcar 'car color-alist)

+          :description "Show COLOR as an CSS RGB literal")))

+

+(defun main ()

+  (let* ((context (net.didierverna.clon:make-context :synopsis *synopsis*))

+         (net.didierverna.clon:*context* context)

+         (foreground (net.didierverna.clon:getopt :context context

+                                                  :long-name "fg"))

+         (background (net.didierverna.clon:getopt :context context

+                                                  :long-name "bg"))

+         (remainder (net.didierverna.clon:remainder :context context))

+         (css (net.didierverna.clon:getopt :context context

+                                           :long-name "css"))

+         (html (net.didierverna.clon:getopt :context context

+                                            :long-name "html")))

+    (cond ((net.didierverna.clon:getopt :context context

+                                        :long-name "help")

+           (net.didierverna.clon:help))

+          ((and html css)

+           (format *error-output* "Can't use HTML and CSS options together~%")

+           (net.didierverna.clon:help))

+          (css

+           (let ((values (cdr (assoc css color-alist))))

+             (format t "rgb(~{~d~^, ~})~%" values)))

+          (html

+           (let ((values (cdr (assoc html color-alist))))

+             (format t "#~{~2,'0x~}~%" values)))

+          ((null remainder)

+           (summary))

+          ((or foreground background)

+           (zenburn-text foreground background "~{~a~^ ~}" remainder))

+          (t

+           (net.didierverna.clon:help)))))

+

+

+(defun dump ()

+  (setf net.didierverna.clon:*context* nil

+        *features* (remove :fw.dump *features*)

+        *print-case* :downcase)

+  (net.didierverna.clon:dump "zenburn" main))