Skip to content

Commit

Permalink
Ensure spaces on padded spans get proper font
Browse files Browse the repository at this point in the history
  • Loading branch information
@hlship
hlship committed Jun 27, 2023
1 parent 9fe5c33 commit 6e09af1
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 53 deletions.
113 changes: 68 additions & 45 deletions src/clj_commons/ansi.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
"Help with generating textual output that includes ANSI escape codes for formatting.
The [[compose]] function is the best starting point.
Reference: [Wikipedia](https://en.wikipedia.org/wiki/ANSI_escape_code#SGR)."
Reference: [ANSI Escape Codes @ Wikipedia](https://en.wikipedia.org/wiki/ANSI_escape_code#SGR)."
(:require [clojure.string :as str]
[clj-commons.pretty-impl :refer [csi padding]]))

Expand Down Expand Up @@ -128,63 +128,89 @@
(throw (ex-info "invalid span declaration"
{:font-decl value}))))

(defn- blank? [value]
(or (nil? value)
(= "" value)))

(defn- normalize-markup
"Normalizes markup to span vectors, while keeping track of the total length of string values."
[coll *length]
(let [f (fn reducer [result input]
(cond
(blank? input)
result

(vector? input)
(let [decl (extract-span-decl (first input))
;; TODO: Maybe we can actually allow nested width-padded spans?
_ (when (:width decl)
(throw (ex-info "can only track one span width at a time"
{:input input})))
;; next on vector is not a vector itself, fortunately
span (reduce reducer [decl] (next input))]
(conj result span))

(sequential? input)
;; Convert to a span with a nil decl
(let [sub-span (reduce reducer [nil] input)]
(conj result sub-span))

:else
(let [value-str ^String (.toString input)]
(vswap! *length + (.length value-str))
(conj result value-str))))]
(reduce f [] coll)))

(defn- collect-markup
[state input]
(cond
(or
(nil? input)
(= "" input))
(blank? input)
state

(vector? input)
(let [[first-element & inputs] input
{:keys [font width pad]} (extract-span-decl first-element)
{:keys [current *width tracking-width? ^StringBuilder buffer]} state
_ (when (and width tracking-width?)
(throw (ex-info "can only track one span width at a time"
{:input input})))
start-width @*width
start-length (.length buffer) ; Needed if :pad is :left
state' (reduce collect-markup
(-> state
(cond-> width (assoc :tracking-width? true))
(update :current update-font-data-from-font-def font)
(update :stack conj current))
inputs)]
;; TODO: treat the spaces same as other characters and deal with deferred
;; font characteristic changes? This will be visible with inverse or
;; underlined spans.
(when width
(let [actual-width (- @*width start-width)
spaces (padding (- width actual-width))]
(when spaces
(if (= :right pad)
(.append buffer spaces)
(.insert buffer start-length spaces))
;; Not really necessary since we don't/can't track nested widths
(vswap! *width + (.length spaces)))))
(-> state'
(assoc :current current
:tracking-width? false)
(update :stack pop)))
{:keys [font width pad] :as span-decl} (extract-span-decl first-element)]
(if width
(let [;; Transform this span and everything below it into easily managed span vectors, starting
;; with a reduced version of the span decl.
span-decl' (dissoc span-decl :width :pad)
*length (volatile! 0)
inputs' (into [span-decl'] (normalize-markup inputs *length))
spaces (padding (- width @*length))
;; Added the padding in the desired position; this ensures that the logic that generates
;; ANSI escape codes occurs correctly, with the added spaces getting the font for this span.
padded (if (= :right pad)
(conj inputs' spaces)
;; An "insert-at" for vectors would be nice
(into [(first inputs') spaces] (next inputs')))]
(recur state padded))
;; Normal (no width tracking)
(let [{:keys [current]} state
state' (reduce collect-markup
(-> state
(update :current update-font-data-from-font-def font)
(update :stack conj current))
inputs)]
(-> state'
(assoc :current current
:tracking-width? false)
(update :stack pop)))))

;; Lists, lazy-lists, etc: processed recursively
(sequential? input)
(reduce collect-markup state input)

:else
(let [{:keys [active current ^StringBuilder buffer *width]} state
(let [{:keys [active current ^StringBuilder buffer]} state
state' (if (= active current)
state
(let [font-str (compose-font active current)]
(when font-str
;; This never counts towards *width
(.append buffer font-str))
(cond-> (assoc state :active current)
font-str (assoc :dirty? true))))
input-str (str input)]
(.append buffer input-str)
(vswap! *width + (.length input-str))
;; Signal that a reset is needed at the very end
font-str (assoc :dirty? true))))]
(.append buffer ^String (.toString input))
state')))

(defn compose
Expand Down Expand Up @@ -225,6 +251,7 @@
The order of the terms does not matter. Behavior for conflicting terms (`:blue.green.black`)
is not defined.
Font defs apply on top of the font def of the enclosing span, and the outer span's font def
is restored at the end of the inner span, e.g. `[:red \" RED \" [:bold \"RED/BOLD\"] \" RED \"]`.
Expand Down Expand Up @@ -265,10 +292,7 @@
[{:font :red
:width 20} message]
This will output the value of `message` in red text, padded with spaces on the left to be 20 characters.
At this time, the placement of the spaces may be a bit haphazard with respect to ANSI codes; the spaces
may be visible if the font def sets inverse, underlined, or colored backgrounds."
This will output the value of `message` in red text, padded with spaces on the left to be 20 characters."
{:added "1.4.0"}
[& inputs]
(let [initial-font {:foreground "39"
Expand All @@ -281,8 +305,7 @@
{:keys [dirty?]} (collect-markup {:stack []
:active initial-font
:current initial-font
:buffer buffer
:*width (volatile! 0)}
:buffer buffer}
inputs)]
(when dirty?
(.append buffer reset-font))
Expand Down
8 changes: 4 additions & 4 deletions test/clj_commons/ansi_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,8 +115,8 @@
[{:width 10
:font :red} "BBB"]
"|")
"START |[CSI]32mAAA [CSI]39m| [CSI]31mBBB[CSI]39m|[CSI]m"
; 0123456789 0123456789
"START |[CSI]32mAAA [CSI]39m|[CSI]31m BBB[CSI]39m|[CSI]m"
; 0123456789 0123456789

'("START |"
[{:width 10
Expand All @@ -126,8 +126,8 @@
[{:width 10
:font :red} "XYZ"]
"|")
"START |[CSI]32mAB[CSI]34mC [CSI]39m| [CSI]31mXYZ[CSI]39m|[CSI]m"
; 0123456789 0123456789
"START |[CSI]32mAB[CSI]34mC[CSI]32m [CSI]39m|[CSI]31m XYZ[CSI]39m|[CSI]m"
; 01 2 3456789 0123456789

;; Only pads, never truncates

Expand Down
9 changes: 5 additions & 4 deletions test/demo.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,10 +95,11 @@

*clojure-version*

;; 11 Feb 2016 - 553 µs (14 µs std dev) - Clojure 1.8
;; 13 Sep 2021 - 401 µs (16 µs std dev) - Clojure 1.11.1
;; 20 Jun 2023 - 713 µs (30 µs std dev) - Clojure 1.11.1, Corretto 17.0.7, M1
;; 25 Jun 2023 - 507 µs - Clojure 1.11.1, Corretto 17.0.7, M1
;; 11 Feb 2016 - 553 µs (14 µs std dev) - Clojure 1.8
;; 13 Sep 2021 - 401 µs (16 µs std dev) - Clojure 1.11.1
;; 20 Jun 2023 - 713 µs (30 µs std dev) - Clojure 1.11.1, Corretto 17.0.7, M1
;; 25 Jun 2023 - 507 µs - Clojure 1.11.1, Corretto 17.0.7, M1
;; 26 Jun 2023 - 1.13 ms - Clojure 1.11.1, Corretto 17.0.7, M1

(let [e (make-ex-info)]
(c/bench (e/format-exception e)))
Expand Down

0 comments on commit 6e09af1

Please sign in to comment.