Merge pull request #56 from hlship/hls/20251023-styles

Add support for overridable styles

Author: hlship

CHANGES.md

@@ -42,6 +42,7 @@
 * Cache files are now stored in `~/.cache/net.lewisship.cli-tools` by default
 * Added initial support for commands defined as Babashka CLI functions
 * Added `net.lewiship.cli-tools.test` namespace
+* Added `net.lewisship.cli-tools.styles` namespace
 
 # 0.15.1 -- 27 Jan 2025
 

deps.edn

@@ -9,7 +9,7 @@
   :license :asl}
 
  :aliases
- {;; clj -X:teBst
+ {;; clj -X:test
   :test
   {:extra-paths ["test" "test-resources"]
    :extra-deps  {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1"
@@ -27,14 +27,14 @@
   {:extra-deps {org.clojure/tools.cli {:mvn/version "1.2.245" :optional true}
                 babashka/fs           {:mvn/version "0.5.27" :optional true}
                 babashka/process      {:mvn/version "0.6.23" :optional true}
-                selmer/selmer         {:mvn/version "1.12.64" :optional true}
+                selmer/selmer         {:mvn/version "1.12.65" :optional true}
                 org.babashka/cli      {:mvn/version "0.8.66" :optional true}}}
 
   :1.11
   {:override-deps {org.clojure/clojure ^:antq/exclude {:mvn/version "1.11.4"}}}
 
   :lint
-  {:deps      {clj-kondo/clj-kondo {:mvn/version "2025.09.22"}}
+  {:deps      {clj-kondo/clj-kondo {:mvn/version "2025.10.23"}}
    :main-opts ["-m" "clj-kondo.main" "--lint" "src" "test"]}
 
   :build

doc/cljdoc.edn

@@ -13,6 +13,7 @@
   ["Babashka CLI" {:file "doc/babashka-cli.md"}]
   ["Caching" {:file "doc/caching.md"}]
   ["Transform" {:file "doc/transform.md"}]
+  ["Styles" {:file "doc/styles.md"}]
   ["Experimental" {:file "doc/experimental.md"}
    ["Completions" {:file "doc/completions.md"}]
    ["Job Board" {:file "doc/jobs.md"}]]]}

doc/styles.md

@@ -0,0 +1,17 @@
+# Styling cli-tools
+
+Beauty is in the eye of the beholder; `cli-tools` makes a default
+set of choices for what kind of colors and fonts to use
+for its output, but this can be overridden.
+
+The `net.lewisship.cli-tools.styles` contains a dynamic var, `*default-styles*`, that is used by the rest of `cli-tools`
+when
+formatting output. By overriding or rebinding this var, the fonts can be overridden.
+
+The most common to override are:
+
+- :tool-name-label (default :bold.green) used when writing the name of the tool itself
+- :command-path (default :bold.green) used when writing the command path
+
+When overriding `*default-styles*`, you can just provide overrides of what's in `default-styles`; anything not found in
+the dynamic var is then searched for in the non-dynamic var.

src/net/lewisship/cli_tools.clj

@@ -5,7 +5,8 @@
             [clojure.string :as string]
             [net.lewisship.cli-tools.impl :as impl :refer [cond-let]]
             [clojure.tools.cli :as cli]
-            [net.lewisship.cli-tools.cache :as cache]))
+            [net.lewisship.cli-tools.cache :as cache]
+            [net.lewisship.cli-tools.styles :refer [style]]))
 
 (defn exit
   "An indirect call to System/exit, passing a numeric status code (0 for success, non-zero for
@@ -426,7 +427,7 @@
 
             :else
             (do
-              (ansi/perr "Input '" [:yellow input] "' not recognized; enter "
+              (ansi/perr "Input '" [(style :invalid-input) input] "' not recognized; enter "
                          (map-indexed
                            (fn [i {:keys [label]}]
                              (list
@@ -445,12 +446,12 @@
 
                                  :else
                                  ", or ")
-                               [:italic label]))
+                               [(style :possible-completion) label]))
                            response-maps)
                          (when default-label
                            (list
                              ", or just enter for the default ("
-                             [:bold default-label]
+                             [(style :default-value) default-label]
                              ")")))
               (recur))))))))
 
@@ -602,7 +603,7 @@
          console (System/console)
          _       (do
                    (when-not console
-                     (abort [:bold.red "Error:"] " no console to read password from"))
+                     (abort [(style :error-label) "Error:"] " no console to read password from"))
 
                    (print (ansi/compose prompt))
                    (flush))
@@ -613,5 +614,5 @@
                    "")]
      (when (and (string/blank? s)
                 (not allow-blank?))
-       (abort [:bold.red "Error:"] " password input may not be blank"))
+       (abort [(style :error-label) "Error:"] " password input may not be blank"))
      s)))

src/net/lewisship/cli_tools/colors.clj

@@ -1,5 +1,4 @@
 (ns net.lewisship.cli-tools.colors
-  {:command-ns 'net.lewisship.cli-tools.builtins}
   (:require [clj-commons.ansi :refer [pout]]
             [clojure.string :as string]
             [net.lewisship.cli-tools :refer [defcommand]]))

src/net/lewisship/cli_tools/completions.clj

@@ -1,6 +1,5 @@
 (ns net.lewisship.cli-tools.completions
   "Support for generating zsh command completion scripts for a command."
-  {:command-ns 'net.lewisship.cli-tools.builtins}
   (:require [babashka.fs :as fs]
             [clojure.java.io :as io]
             [net.lewisship.cli-tools :refer [defcommand abort command-path]]

src/net/lewisship/cli_tools/impl.clj

@@ -2,6 +2,7 @@
   "Private namespace for implementation details for new.lewisship.cli-tools, subject to change."
   (:require [clojure.string :as string]
             [clj-commons.ansi :refer [compose pout perr]]
+            [net.lewisship.cli-tools.styles :refer [style]]
             [clojure.tools.cli :as cli]
             [clj-commons.humanize :as h]
             [clj-commons.humanize.inflect :as inflect]
@@ -186,12 +187,13 @@
       "Usage: "
       ;; A stand-alone tool doesn't have a tool-name (*options* will be nil)
       (when tool-name
-        [:bold.green tool-name " "])
+        [(style :tool-name) tool-name " "])
       ;; A stand-alone tool will use its command-name, a command within
       ;; a multi-command tool will have a command-path.
-      [:bold.green (if command-path
-                     (string/join " " command-path)
-                     command-name)]
+      [(style :command-path)
+       (if command-path
+         (string/join " " command-path)
+         command-name)]
       " [OPTIONS]"
       (map list (repeat " ") arg-strs))
     (when command-doc
@@ -210,7 +212,7 @@
             lines           (for [{:keys [label doc]} positional-specs]
                               (list
                                 [{:width max-label-width}
-                                 [:bold label]]
+                                 [(style :option-label) label]]
                                 ": "
                                 doc))]
         (pout "\nArguments:")
@@ -220,7 +222,7 @@
   [errors]
   (let [{:keys [tool-name]} *tool-options*]
     (perr
-      [:red
+      [(style :parse-error)
        (inflect/pluralize-noun (count errors) "Error")
        (when tool-name
          (list
@@ -266,9 +268,9 @@
                            (when default-fn "<computed>")
                            "")
                        "")]
-    {:opt-label     [:bold opt-label]
+    {:opt-label     [(style :option-label) opt-label]
      :opt-width     (.length opt-label)
-     :default       [:italic default-desc]
+     :default       [(style :option-default) default-desc]
      :default-width (.length default-desc)
      :opt-desc      desc}))
 
@@ -707,7 +709,9 @@
     (collect-subs command-root *result)
     (-> *result deref persistent!)))
 
-(def ^:private missing-doc [:yellow.italic "(missing documentation)"])
+(defn- missing-doc
+  []
+  [(style :missing-doc) "(missing documentation)"])
 
 (defn extract-command-title
   [command-map]
@@ -733,7 +737,7 @@
              (list
                (h/numberword group-count) " "
                (inflect/pluralize-noun group-count "sub-group")))]))
-      missing-doc))
+      (missing-doc)))
 
 (defn- print-commands
   [command-name-width container-map commands-map recurse?]
@@ -747,10 +751,10 @@
                                      (reduce max 0)))]
     (when container-map
       (pout (when recurse? "\n")
-            [:bold (string/join " " (:command-path container-map))]
+            [(style :command) (string/join " " (:command-path container-map))]
             " - "
             (or (some-> container-map :group-doc cleanup-docstring)
-                missing-doc)))
+                (missing-doc))))
 
     (when (seq sorted-commands)
       (pout "\nCommands:"))
@@ -759,9 +763,9 @@
     (doseq [{:keys [fn command] :as command-map} sorted-commands]
       (pout
         "  "
-        [{:width command-name-width'} [:bold.green command]]
+        [{:width command-name-width'} [(style :command-path) command]]
         ": "
-        [(when-not fn :italic)
+        [(when-not fn (style :subgroup-label))
          (extract-command-title command-map)]))
 
     ;; Recurse and print sub-groups
@@ -781,7 +785,7 @@
         matching-commands (->> (filter #(command-match? % search-term') all-commands)
                                (map #(update % :command-path join-command-path)))]
     (if-not (seq matching-commands)
-      (pout "No commands match " [:italic search-term'])
+      (pout "No commands match " [(style :search-term) search-term'])
       (let [command-width (->> matching-commands
                                (map :command-path)
                                (map count)
@@ -792,10 +796,10 @@
           (if (= n 1)
             " command matches "
             " commands match ")
-          [:italic search-term']
+          [(style :search-term) search-term']
           ":" "\n")
         (doseq [{:keys [command-path] :as command} (sort-by :command-path matching-commands)]
-          (pout [{:font  :bold.green
+          (pout [{:font  (style :command-path)
                   :width command-width}
                  command-path]
                 ": "
@@ -805,7 +809,7 @@
   [level]
   (let [{tool-doc :doc
          :keys    [tool-name command-root]} *tool-options*]
-    (pout "Usage: " [:bold.green tool-name] " [OPTIONS] COMMAND ...")
+    (pout "Usage: " [(style :tool-name) tool-name] " [OPTIONS] COMMAND ...")
     (when tool-doc
       (pout "\n"
             (cleanup-docstring tool-doc)))
@@ -841,21 +845,22 @@
       (sort (filter (to-matcher s) values')))))
 
 (def ^:private help
-  (list
-    [:bold.green "--help"] " (or " [:bold.green "-h"] ") to list commands"))
+  (let [option-style (style :option-name)]
+    (list
+      [option-style "--help"] " (or " [option-style "-h"] ") to list commands")))
 
 (defn- use-help-message
   [tool-name]
-  (list ", use " [:bold.green tool-name] " " help))
+  (list ", use " [(style :tool-name) tool-name] " " help))
 
 (defn- no-command
   [tool-name]
-  (abort [:bold.green tool-name] ": no command provided" (use-help-message tool-name)))
+  (abort [(style :tool-name) tool-name] ": no command provided" (use-help-message tool-name)))
 
 (defn- incomplete
   [tool-name command-path matchable-terms]
   (abort
-    [:bold.green tool-name ": "
+    [(style :tool-name) tool-name ": "
      (string/join " " command-path)]
     " is incomplete; "
     (compose-list matchable-terms)
@@ -877,10 +882,11 @@
                       " "
                       help)]
     (abort
-      [:bold [:green tool-name] ": "
-       [:green (string/join " " command-path)]
+      [(style :no-command-match)
+       [(style :tool-name) tool-name] ": "
+       [(style :command-path) (string/join " " command-path)]
        (when (seq command-path) " ")
-       [:red term]]
+       [(style :unknown-term) term]]
       " "
       body
       help-suffix)))

src/net/lewisship/cli_tools/job_status_demo.clj

@@ -4,8 +4,8 @@
             [net.lewisship.cli-tools.job-status :as j]))
 
 (defn sleep
-  ([ms] (Thread/sleep ms))
-  ([job-id ms]
+  ([^long ms] (Thread/sleep ms))
+  ([job-id ^long ms]
    (Thread/sleep ms)
    job-id))
 
@@ -68,4 +68,4 @@
       (j/summary "Please fasten your Bat-seatbelts")
       done)
 
-  (Thread/sleep 3000))
+  (sleep 3000))

src/net/lewisship/cli_tools/styles.clj

@@ -0,0 +1,29 @@
+(ns net.lewisship.cli-tools.styles
+  "Defines styles (ANSI fonts) for output from cli-tools."
+  {:added "0.16.0"})
+
+(def default-styles
+  {:invalid-input       :yellow
+   :possible-completion :italic
+   :default-value       :bold
+   :error-label         :bold.red
+   :tool-name           :bold.green
+   :command-path        :bold.green
+   :option-label        :bold
+   :option-default      :italic
+   :parse-error         :red
+   :missing-doc         :yellow.italic
+   :command             :bold
+   :subgroup-label      :italic
+   :search-term         :italic
+   :option-name         :bold.green
+   :no-command-match    :bold
+   :unknown-term        :red})
+
+(def ^:dynamic *default-styles* default-styles)
+
+(defn style
+  "Retrieves a style; searches in *default-styles* first and, if not found, then in the default-styles."
+  [k]
+  (or (get *default-styles* k)
+      (get default-styles k)))