From 9150c90ad1c421c1bbb08d29cbcd1766a001ddb7 Mon Sep 17 00:00:00 2001 From: Adam Jeniski Date: Tue, 3 Feb 2026 12:22:47 -0500 Subject: [PATCH] refactor --- src/tui/core.clj | 244 +++++++++++++++---- src/tui/events.clj | 324 +++++++++++++++++++++++++ src/tui/input.clj | 200 +++++++++++----- src/tui/render.clj | 442 +++++++++++++++++++++++++++++++---- test/tui/core_test.clj | 176 +++++++++++--- test/tui/edge_cases_test.clj | 25 +- test/tui/events_test.clj | 140 +++++++++++ test/tui/input_test.clj | 122 ++++++++-- test/tui/render_test.clj | 188 ++++++++++++++- 9 files changed, 1643 insertions(+), 218 deletions(-) create mode 100644 src/tui/events.clj create mode 100644 test/tui/events_test.clj diff --git a/src/tui/core.clj b/src/tui/core.clj index ff7448b..8f6f71b 100644 --- a/src/tui/core.clj +++ b/src/tui/core.clj @@ -1,57 +1,162 @@ (ns tui.core - "Core TUI framework - Elm architecture runtime." + "Core TUI framework - Elm architecture runtime. + + ## New API (Recommended) + + Update function signature: + (fn [{:keys [model event]}] + {:model new-model + :events [...]}) ; :events is optional + + Events are maps with :type discriminator. See tui.events namespace. + + ## Legacy API (Deprecated) + + For backward compatibility, the old signature is still supported: + (fn [model msg] [new-model cmd]) + + The runtime auto-detects which format is being used." (:require [tui.terminal :as term] [tui.input :as input] [tui.render :as render] [tui.ansi :as ansi] [clojure.core.async :as async :refer [go go-loop chan ! >!! ! msg-chan event))) + + ;; Shell - run command async + :shell + (let [{:keys [cmd event]} event + cmd-str (if (vector? cmd) + (clojure.string/join " " cmd) + cmd)] + (go + (try + (let [proc (.. (ProcessBuilder. (into-array String ["sh" "-c" cmd-str])) + (redirectErrorStream false) + (start)) + out (slurp (.getInputStream proc)) + err (slurp (.getErrorStream proc)) + exit (.waitFor proc) + success (zero? exit)] + (>! msg-chan (assoc event :result + {:exit exit + :out out + :err err + :success success}))) + (catch Exception e + (>! msg-chan (assoc event :result + {:exit -1 + :out "" + :err (str e) + :success false})))))) + + ;; Batch - run all in parallel + :batch + (doseq [e (:events event)] + (execute-event! e msg-chan)) + + ;; Sequential - run one after another + :sequential + (go-loop [[e & rest-events] (:events event)] + (when e + (let [result-chan (chan 1)] + (execute-event! e result-chan) + (when-let [result (! msg-chan result) + (recur rest-events))))) + + ;; Debounce - cancel pending, schedule new + :debounce + (let [{:keys [id ms event]} event] + ;; Cancel existing timer for this id + (when-let [cancel-fn (get @debounce-timers id)] + (cancel-fn)) + ;; Schedule new timer + (let [cancelled (atom false) + cancel-fn #(reset! cancelled true)] + (swap! debounce-timers assoc id cancel-fn) + (go + (! msg-chan event))))) + + ;; Unknown type - dispatch to update function + (put! msg-chan event))))) + +;; === Legacy Command Execution === (defn- execute-cmd! - "Execute a command, putting resulting messages on the channel." + "Execute a legacy command, putting resulting messages on the channel." [cmd msg-chan] (when cmd (cond ;; Quit command (= cmd [:quit]) - (put! msg-chan [:quit]) + (put! msg-chan {:type :quit}) ;; Batch - run all in parallel (and (vector? cmd) (= (first cmd) :batch)) @@ -80,37 +185,74 @@ ;; === Input Loop === (defn- start-input-loop! - "Start thread that reads input and puts messages on channel. + "Start thread that reads input and puts events on channel. Uses polling with timeout to allow clean shutdown when running? becomes false." [msg-chan running?] (async/thread (loop [] (when @running? (if (term/input-ready?) - (when-let [key-msg (input/read-key)] - (>!! msg-chan key-msg)) + (when-let [key-event (input/read-key)] + (>!! msg-chan key-event)) ;; No input ready, sleep briefly and check running? again (Thread/sleep 10)) (recur))))) +;; === Update Function Detection === +(defn- detect-update-format + "Detect if update function uses new or legacy format by examining its signature. + Returns :new or :legacy." + [update-fn] + ;; We can't easily detect at compile time, so we'll detect at runtime + ;; by checking the result format + :unknown) + +(defn- call-update + "Call update function, handling both new and legacy formats. + Returns {:model m :events [...]} in new format." + [update-fn model event legacy-mode?] + (if legacy-mode? + ;; Legacy: (fn [model msg] [new-model cmd]) + (let [[new-model cmd] (update-fn model event)] + {:model new-model + :legacy-cmd cmd}) + ;; New: (fn [{:keys [model event]}] {:model m :events [...]}) + (let [result (update-fn {:model model :event event})] + (if (vector? result) + ;; Got legacy format back, switch to legacy mode + {:model (first result) + :legacy-cmd (second result) + :switch-to-legacy true} + ;; New format + result)))) + ;; === Main Run Loop === (defn run "Run a TUI application. + ## New API (Recommended) + Options: - - :init - Initial model (required) - - :update - (fn [model msg] [new-model cmd]) (required) - - :view - (fn [model size] hiccup) where size is {:width w :height h} (required) - - :init-cmd - Initial command to run - - :fps - Target frames per second (default 60) + - :init - Initial model (required) + - :update - (fn [{:keys [model event]}] {:model m :events [...]}) (required) + - :view - (fn [model size] hiccup) where size is {:width w :height h} (required) + - :fps - Target frames per second (default 60) - :alt-screen - Use alternate screen buffer (default true) + ## Legacy API (Deprecated) + + Also accepts: + - :update - (fn [model msg] [new-model cmd]) + - :init-cmd - Initial command to run + Returns the final model." - [{:keys [init update view init-cmd fps alt-screen] + [{:keys [init update view init-cmd init-events fps alt-screen] :or {fps 60 alt-screen true}}] (let [msg-chan (chan 256) running? (atom true) - frame-time (/ 1000 fps)] + frame-time (/ 1000 fps) + ;; Start in auto-detect mode, will switch to legacy if needed + legacy-mode? (atom false)] ;; Setup terminal (term/raw-mode!) @@ -122,7 +264,10 @@ ;; Start input loop (start-input-loop! msg-chan running?) - ;; Execute initial command + ;; Execute initial events/command + (when init-events + (doseq [event init-events] + (execute-event! event msg-chan))) (when init-cmd (execute-cmd! init-cmd msg-chan)) @@ -137,29 +282,36 @@ last-render (System/currentTimeMillis)] (let [;; Wait for message with timeout for frame limiting remaining (max 1 (- frame-time (- (System/currentTimeMillis) last-render))) - msg (alt!! - msg-chan ([v] v) - (timeout remaining) nil)] + event (alt!! + msg-chan ([v] v) + (timeout remaining) nil)] - (if (or (nil? msg) (not @running?)) + (if (or (nil? event) (not @running?)) ;; No message, just continue (recur model (System/currentTimeMillis)) - ;; Process message - (if (= msg [:quit]) + ;; Check for quit + (if (or (= event {:type :quit}) + (= event [:quit])) ; legacy ;; Quit - return final model model ;; Update model - (let [[new-model cmd] (update model msg) + (let [result (call-update update model event @legacy-mode?) + _ (when (:switch-to-legacy result) + (reset! legacy-mode? true)) + new-model (:model result) size (term/get-terminal-size) ctx {:available-height (:height size) :available-width (:width size)} now (System/currentTimeMillis)] - ;; Execute command - (when cmd - (execute-cmd! cmd msg-chan)) + ;; Execute events (new API) or command (legacy) + (if-let [events (:events result)] + (doseq [e events] + (execute-event! e msg-chan)) + (when-let [cmd (:legacy-cmd result)] + (execute-cmd! cmd msg-chan))) ;; Render with context for flex layouts (term/render! (render/render (view new-model size) ctx)) @@ -169,6 +321,7 @@ (finally ;; Cleanup (reset! running? false) + (reset! debounce-timers {}) (close! msg-chan) (when alt-screen (term/exit-alt-screen!)) (term/restore!) @@ -182,23 +335,28 @@ (defapp my-app :init {:count 0} - :update (fn [model msg] ...) - :view (fn [model] ...))" - [name & {:keys [init update view init-cmd]}] + :update (fn [ctx] ...) + :view (fn [model size] ...))" + [name & {:keys [init update view init-cmd init-events]}] `(def ~name {:init ~init :update ~update :view ~view - :init-cmd ~init-cmd})) + :init-cmd ~init-cmd + :init-events ~init-events})) -;; === Key Matching Helpers === +;; === Legacy Key Matching Helpers (Deprecated) === (defn key= - "Check if message is a specific key." + "DEPRECATED: Use tui.events/key= instead. + + Check if message is a specific key." [msg key-pattern] (input/key-match? msg key-pattern)) (defn key-str - "Get string representation of key." + "DEPRECATED: Use tui.input/key->str instead. + + Get string representation of key." [msg] (input/key->str msg)) diff --git a/src/tui/events.clj b/src/tui/events.clj new file mode 100644 index 0000000..7d9d4ae --- /dev/null +++ b/src/tui/events.clj @@ -0,0 +1,324 @@ +(ns tui.events + "Event constructors and key matching for the TUI framework. + + Events are the unified message format for the TUI system. All events + are maps with a :type key as discriminator. Events flow in both + directions: from the runtime to the update function (key presses, + shell results), and from the update function to the runtime (quit, + delay, shell commands). + + ## Event Format + + All events are maps with :type as the discriminator: + + {:type :key, :key \\a} ; key press + {:type :key, :key :enter} ; special key + {:type :key, :key \\c, :modifiers #{:ctrl}} ; with modifiers + {:type :quit} ; quit app + {:type :delay, :ms 2000, :event {...}} ; delayed event + + ## Update Function Contract + + (fn [{:keys [model event]}] + {:model new-model + :events [...]}) ; :events is optional + + ## Key Event Format + + Key events use :type :key with: + :key - Character (\\a-\\z, \\0-\\9) or keyword (:enter, :up, etc.) + :modifiers - Optional set of #{:ctrl :alt :shift :super :capslock} + + Characters are normalized to lowercase. Uppercase letters have + :shift in :modifiers.") + +;;; ============================================================ +;;; Key Matching +;;; ============================================================ + +(defn key= + "Check if an event matches a key pattern. + + Takes an event map and a key pattern, optionally with required modifiers. + Returns true if the event is a key event matching the pattern. + + Arguments: + event - Event map from the TUI runtime + key - Character (\\a-\\z, \\0-\\9, etc.) or keyword (:enter, :escape, :up, etc.) + modifiers - Optional set of required modifiers: #{:ctrl :alt :shift :super :capslock} + + Key patterns: + Characters are normalized to lowercase. Use #{:shift} modifier for uppercase. + Special keys use keywords: :enter :escape :tab :backspace :delete + :up :down :left :right :home :end + :page-up :page-down :insert + :f1 :f2 ... :f12 + + Examples: + ;; Match plain 'q' key + (key= event \\q) + + ;; Match Enter key + (key= event :enter) + + ;; Match Ctrl+C + (key= event \\c #{:ctrl}) + + ;; Match uppercase 'Z' (Shift+z) + (key= event \\z #{:shift}) + + ;; Match Ctrl+Shift+Z (common redo shortcut) + (key= event \\z #{:ctrl :shift}) + + ;; Match Ctrl+Enter + (key= event :enter #{:ctrl}) + + ;; Match Alt+F4 + (key= event :f4 #{:alt}) + + Usage in update function: + (defn update [{:keys [model event]}] + (cond + (key= event \\q) {:model model, :events [(quit)]} + (key= event \\s #{:ctrl}) {:model (save model)} + (key= event :up) {:model (cursor-up model)} + (key= event \\z #{:ctrl}) {:model (undo model)} + :else {:model model}))" + ([event key] + (key= event key nil)) + ([event key modifiers] + (and (= (:type event) :key) + (= (:key event) key) + (= (:modifiers event) modifiers)))) + +;;; ============================================================ +;;; Event Constructors +;;; ============================================================ + +(defn quit + "Create a quit event that exits the application. + + Takes no arguments. When processed, cleanly shuts down the TUI, + restores terminal state, and returns the final model. + + Returns: + {:type :quit} + + Examples: + ;; Quit on 'q' key + (defn update [{:keys [model event]}] + (if (key= event \\q) + {:model model, :events [(quit)]} + {:model model})) + + ;; Quit after confirmation + (defn update [{:keys [model event]}] + (cond + (and (= (:mode model) :confirm-quit) + (key= event \\y)) + {:model model, :events [(quit)]} + + (key= event \\q) + {:model (assoc model :mode :confirm-quit)} + + :else + {:model model}))" + [] + {:type :quit}) + +(defn delay + "Create an event that dispatches another event after a delay. + + The nested event is dispatched after the specified milliseconds elapse. + Useful for transient messages, animations, debouncing, or timeouts. + + Arguments: + ms - Delay in milliseconds before dispatching + event - Event map to dispatch after the delay + + Returns: + {:type :delay, :ms , :event } + + Examples: + ;; Show a message that auto-clears after 3 seconds + (defn update [{:keys [model event]}] + (case (:type event) + :show-message + {:model (assoc model :message (:text event)) + :events [(delay 3000 {:type :clear-message})]} + + :clear-message + {:model (dissoc model :message)} + + {:model model})) + + ;; Auto-save after 5 seconds of inactivity + (defn update [{:keys [model event]}] + (if (= (:type event) :key) + {:model (-> model + (update :buffer conj event) + (assoc :dirty true)) + :events [(delay 5000 {:type :auto-save})]} + {:model model})) + + ;; Simple animation frame + {:events [(delay 16 {:type :animation-tick})]}" + [ms event] + {:type :delay, :ms ms, :event event}) + +(defn shell + "Create an event that runs a shell command asynchronously. + + The command runs in a separate thread without blocking the UI. + When complete, dispatches the provided event with :result merged in. + + Arguments: + cmd - Command as vector of strings [\"git\" \"status\"] + event - Event map to dispatch when complete. + The event will have :result key merged in with: + :exit - Exit code (0 = success) + :out - Stdout as string + :err - Stderr as string + :success - Boolean, true if exit code 0 + + Returns: + {:type :shell, :cmd , :event } + + Examples: + ;; Run git status and process result + (defn update [{:keys [model event]}] + (case (:type event) + :refresh + {:model (assoc model :loading true) + :events [(shell [\"git\" \"status\" \"--porcelain\"] + {:type :git-status-result})]} + + :git-status-result + (let [{:keys [success out err]} (:result event)] + (if success + {:model (-> model + (assoc :loading false) + (assoc :files (parse-status out)))} + {:model (-> model + (assoc :loading false) + (assoc :error err))})) + + {:model model})) + + ;; Run git diff for selected file + (shell [\"git\" \"diff\" \"--\" path] + {:type :diff-result, :file file}) + + ;; Pass context through the event + (shell [\"git\" \"add\" \"--\" path] + {:type :file-staged, :path path})" + [cmd event] + {:type :shell, :cmd cmd, :event event}) + +(defn batch + "Create an event that processes multiple events in parallel. + + All events start immediately and run concurrently. + Useful when you need to trigger multiple independent operations. + + Arguments: + events - Variable number of event maps + + Returns: + {:type :batch, :events []} + Returns nil if no events provided. + + Examples: + ;; Refresh multiple data sources in parallel + (defn update [{:keys [model event]}] + (if (key= event \\r) + {:model (assoc model :loading true) + :events [(batch + (shell [\"git\" \"status\" \"--porcelain\"] + {:type :status-result}) + (shell [\"git\" \"log\" \"--oneline\" \"-10\"] + {:type :log-result}) + (shell [\"git\" \"branch\"] + {:type :branch-result}))]} + {:model model})) + + ;; Show message and trigger async operation + (batch + {:type :show-spinner} + (shell [\"git\" \"push\"] {:type :push-complete}))" + [& events] + (when-let [evts (seq (remove nil? events))] + {:type :batch, :events (vec evts)})) + +(defn sequential + "Create an event that processes multiple events in sequence. + + Each event completes before the next one starts. + The result events are dispatched in order. + Useful when operations must happen in a specific order. + + Arguments: + events - Variable number of event maps + + Returns: + {:type :sequential, :events []} + Returns nil if no events provided. + + Examples: + ;; Stage file, then commit, then push + (sequential + (shell [\"git\" \"add\" \"--all\"] {:type :staged}) + (shell [\"git\" \"commit\" \"-m\" msg] {:type :committed}) + (shell [\"git\" \"push\"] {:type :pushed})) + + ;; Show message, wait, then clear + (sequential + {:type :show-message, :text \"Saved!\"} + (delay 2000 {:type :clear-message})) + + Note: + For complex workflows, consider handling each step explicitly + in your update function for better error handling and control." + [& events] + (when-let [evts (seq (remove nil? events))] + {:type :sequential, :events (vec evts)})) + +(defn debounce + "Create an event that debounces dispatch. + + Delays dispatching the event until the specified time has passed + without another debounce event with the same id being created. + Useful for search-as-you-type, resize handling, or any input + that fires rapidly but should only trigger action after settling. + + Arguments: + id - Keyword identifying this debounce group. New debounce + events with the same id cancel pending ones. + ms - Milliseconds to wait after last debounce before dispatching + event - Event map to dispatch after debounce period + + Returns: + {:type :debounce, :id , :ms , :event } + + Examples: + ;; Search as you type with 300ms debounce + (defn update [{:keys [model event]}] + (if (and (= (:type event) :key) + (= (:mode model) :search)) + (let [new-query (str (:query model) (:key event))] + {:model (assoc model :query new-query) + :events [(debounce :search 300 + {:type :execute-search, :query new-query})]}) + {:model model})) + + ;; Debounce window resize events + (defn update [{:keys [model event]}] + (if (= (:type event) :resize) + {:model model + :events [(debounce :resize 100 + {:type :layout-changed + :width (:width event) + :height (:height event)})]} + {:model model}))" + [id ms event] + {:type :debounce, :id id, :ms ms, :event event}) diff --git a/src/tui/input.clj b/src/tui/input.clj index d6326da..46df75a 100644 --- a/src/tui/input.clj +++ b/src/tui/input.clj @@ -1,12 +1,27 @@ (ns tui.input - "Parse terminal input into key messages." + "Parse terminal input into key events. + + Key events are maps with the following structure: + {:type :key, :key , :modifiers } + + Where: + :key - Character (lowercase \\a-\\z, \\0-\\9, etc.) or keyword + (:enter, :escape, :up, :down, etc.) + :modifiers - Optional set of #{:ctrl :alt :shift} + Omitted when empty. + + Examples: + {:type :key, :key \\a} ; lowercase 'a' + {:type :key, :key \\a, :modifiers #{:shift}} ; uppercase 'A' + {:type :key, :key \\c, :modifiers #{:ctrl}} ; Ctrl+C + {:type :key, :key :enter} ; Enter key + {:type :key, :key :f1, :modifiers #{:alt}} ; Alt+F1" (:require [tui.terminal :as term])) -;; === Key Message Structure === -;; [:key {:type :rune :char \a}] -;; [:key {:type :special :key :up}] -;; [:key {:type :special :key :enter}] -;; [:key {:type :ctrl :char \c}] +;; === Control Key Mappings === +;; Maps byte codes 0-31 to either: +;; - [:ctrl \x] for Ctrl+letter combinations +;; - keyword for special keys (:enter, :tab, etc.) (def ^:private ctrl-keys {0 [:ctrl \space] ; Ctrl+Space / Ctrl+@ @@ -22,6 +37,9 @@ 28 [:ctrl \\] 29 [:ctrl \]] 30 [:ctrl \^] 31 [:ctrl \_] 127 :backspace}) +;; === CSI Escape Sequences === +;; Maps escape sequences to special key keywords + (def ^:private csi-sequences {"A" :up "B" :down "C" :right "D" :left "H" :home "F" :end "Z" :shift-tab @@ -35,13 +53,34 @@ ;; xterm-style function keys "OP" :f1 "OQ" :f2 "OR" :f3 "OS" :f4}) +;; === Event Constructors === + +(defn- make-key-event + "Create a key event map. Omits :modifiers when empty." + ([key] + {:type :key, :key key}) + ([key modifiers] + (if (seq modifiers) + {:type :key, :key key, :modifiers modifiers} + {:type :key, :key key}))) + +(defn- normalize-char + "Normalize a character to lowercase and return [char modifiers]. + Uppercase letters get #{:shift} modifier." + [c] + (if (Character/isUpperCase c) + [(Character/toLowerCase c) #{:shift}] + [c nil])) + +;; === Escape Sequence Parsing === + (defn- read-escape-sequence "Read and parse an escape sequence." [] (let [c2 (term/read-char-timeout 50)] (cond (nil? c2) - [:key :escape] + (make-key-event :escape) (= c2 \[) ;; CSI sequence @@ -49,7 +88,7 @@ (let [c (term/read-char-timeout 50)] (cond (nil? c) - [:key :escape] + (make-key-event :escape) ;; Parameters and intermediates (or (<= 0x30 (int c) 0x3F) ; 0-9:;<=>? @@ -60,27 +99,39 @@ (<= 0x40 (int c) 0x7E) (let [seq-str (str (apply str buf) c)] (if-let [key (get csi-sequences seq-str)] - [:key key] - [:key :unknown seq-str])) + (make-key-event key) + (make-key-event :unknown))) :else - [:key :unknown (str "[" (apply str buf) c)]))) + (make-key-event :unknown)))) (= c2 \O) ;; SS3 sequence (F1-F4 on some terminals) (let [c3 (term/read-char-timeout 50)] (if c3 (if-let [key (get csi-sequences (str "O" c3))] - [:key key] - [:key :unknown (str "O" c3)]) - [:key :escape])) + (make-key-event key) + (make-key-event :unknown)) + (make-key-event :escape))) :else ;; Alt+key - [:key {:alt true :char c2}]))) + (let [[normalized-char shift-mod] (normalize-char c2) + modifiers (if shift-mod + #{:alt :shift} + #{:alt})] + (make-key-event normalized-char modifiers))))) + +;; === Main Key Reading === (defn read-key - "Read a single key event. Returns [:key ...] message." + "Read a single key event from terminal input. + + Returns a key event map: + {:type :key, :key } + {:type :key, :key , :modifiers #{...}} + + Returns nil if no input available." [] (when-let [c (term/read-char)] (let [code (int c)] @@ -89,64 +140,93 @@ (= code 27) (read-escape-sequence) - ;; Control characters + ;; Control characters (0-31) (<= 0 code 31) (let [key (get ctrl-keys code)] (if (vector? key) - [:key {:ctrl true :char (second key)}] - [:key key])) + ;; [:ctrl \x] format + (make-key-event (second key) #{:ctrl}) + ;; keyword like :enter, :tab + (make-key-event key))) ;; DEL (Ctrl+Backspace on some terminals) (= code 127) - [:key :backspace] + (make-key-event :backspace) - ;; Normal character + ;; Normal character - normalize case :else - [:key {:char c}])))) + (let [[normalized-char shift-mod] (normalize-char c)] + (make-key-event normalized-char shift-mod)))))) + +;; === Legacy Compatibility === +;; These functions support the old API during migration (defn key-match? - "Check if a key message matches a pattern. - Patterns: :enter, :up, \"q\", [:ctrl \\c], etc." - [msg pattern] - (when (= (first msg) :key) - (let [key (second msg)] - (cond - ;; Simple keyword match - (keyword? pattern) - (or (= key pattern) - (= (:key key) pattern)) + "DEPRECATED: Use tui.events/key= instead. - ;; String match (single char) - (string? pattern) - (and (map? key) - (= (:char key) (first pattern)) - (not (:ctrl key)) - (not (:alt key))) + Check if a key event matches a pattern. + Supports both old [:key ...] and new {:type :key ...} formats." + [event pattern] + (let [;; Handle both old and new event formats + key-data (if (vector? event) + (second event) + event) + ;; Extract key and modifiers from new format + key-val (if (map? key-data) + (or (:key key-data) (:char key-data)) + key-data) + modifiers (when (map? key-data) + (:modifiers key-data)) + has-ctrl (or (contains? modifiers :ctrl) + (when (map? key-data) (:ctrl key-data))) + has-alt (or (contains? modifiers :alt) + (when (map? key-data) (:alt key-data)))] + (cond + ;; Simple keyword match (:enter, :up, etc.) + (keyword? pattern) + (= key-val pattern) - ;; Vector pattern [:ctrl \c] - (vector? pattern) - (let [[mod ch] pattern] - (and (map? key) - (case mod - :ctrl (and (:ctrl key) (= (:char key) ch)) - :alt (and (:alt key) (= (:char key) ch)) - false))) + ;; String match (single char) - no modifiers + (string? pattern) + (and (= key-val (first pattern)) + (not has-ctrl) + (not has-alt)) - :else false)))) + ;; Vector pattern [:ctrl \c] + (vector? pattern) + (let [[mod ch] pattern] + (and (= key-val ch) + (case mod + :ctrl has-ctrl + :alt has-alt + false))) + + :else false))) (defn key->str - "Convert key message to human-readable string." - [msg] - (when (= (first msg) :key) - (let [key (second msg)] - (cond - (keyword? key) - (name key) + "Convert key event to human-readable string. + Supports both old [:key ...] and new {:type :key ...} formats." + [event] + (let [;; Handle both old and new event formats + key-data (if (vector? event) + (second event) + event)] + (cond + (keyword? key-data) + (name key-data) - (map? key) - (str (when (:ctrl key) "ctrl+") - (when (:alt key) "alt+") - (:char key)) + (map? key-data) + (let [key-val (or (:key key-data) (:char key-data)) + modifiers (:modifiers key-data) + ctrl (or (contains? modifiers :ctrl) (:ctrl key-data)) + alt (or (contains? modifiers :alt) (:alt key-data)) + shift (contains? modifiers :shift)] + (str (when ctrl "ctrl+") + (when alt "alt+") + (when shift "shift+") + (if (keyword? key-val) + (name key-val) + key-val))) - :else - (str key))))) + :else + (str key-data)))) diff --git a/src/tui/render.clj b/src/tui/render.clj index 86185d1..53d6cf2 100644 --- a/src/tui/render.clj +++ b/src/tui/render.clj @@ -3,6 +3,120 @@ (:require [tui.ansi :as ansi] [clojure.string :as str])) +;; === Enhanced Sizing System === + +(defn parse-size-spec + "Parse a size specification into a normalized map. + Supports: + - Numbers: fixed size (e.g., 30) + - :flex or {:flex n}: weighted flex (default weight 1) + - \"N%\": percentage of remaining space + - \"Nfr\": fractional unit (like CSS Grid fr) + - {:percent N :min X :max Y}: percentage with constraints + + Returns {:type :fixed|:flex|:percent|:fr :value N :min M :max M}" + [spec] + (cond + ;; nil means auto-size (not constrained) + (nil? spec) + {:type :auto :value nil} + + ;; Numbers are fixed + (number? spec) + {:type :fixed :value spec} + + ;; :flex is shorthand for {:flex 1} + (= spec :flex) + {:type :flex :value 1} + + ;; {:flex n} for weighted flex + (and (map? spec) (:flex spec)) + {:type :flex :value (:flex spec) :min (:min spec) :max (:max spec)} + + ;; {:percent n ...} for percentage with constraints + (and (map? spec) (:percent spec)) + {:type :percent :value (:percent spec) :min (:min spec) :max (:max spec)} + + ;; String "N%" for percentage + (and (string? spec) (str/ends-with? spec "%")) + (let [n (parse-long (subs spec 0 (dec (count spec))))] + {:type :percent :value n}) + + ;; String "Nfr" for fractional unit (treated like flex) + (and (string? spec) (str/ends-with? spec "fr")) + (let [n (parse-long (subs spec 0 (- (count spec) 2)))] + {:type :fr :value n}) + + ;; Unknown - treat as auto + :else + {:type :auto :value nil})) + +(defn calculate-sizes + "Calculate sizes for children given a size specification. + Uses 4-phase algorithm: + 1. Fixed - subtract literal numbers from available + 2. Percentages - calculate against remaining (scale if >100%) + 3. Fr/Flex - divide remaining proportionally + 4. Constraints - apply min/max, redistribute if needed + + Returns vector of calculated sizes (numbers or nil for auto)." + [specs children available-size gap] + (let [num-children (count children) + ;; Ensure we have specs for all children + specs-vec (if specs + (vec (take num-children (concat specs (repeat nil)))) + (vec (repeat num-children nil))) + ;; Parse all specs + parsed (mapv parse-size-spec specs-vec) + ;; Calculate total gap + total-gap (* gap (max 0 (dec num-children))) + usable-size (max 0 (- available-size total-gap)) + + ;; Phase 1: Fixed sizes + fixed-total (reduce + 0 (for [p parsed :when (= (:type p) :fixed)] + (:value p))) + after-fixed (max 0 (- usable-size fixed-total)) + + ;; Phase 2: Percentages (calculate against remaining after fixed) + percent-specs (filter #(= (:type %) :percent) parsed) + total-percent (reduce + 0 (map :value percent-specs)) + ;; Scale down if percentages exceed 100% + percent-scale (if (> total-percent 100) (/ 100.0 total-percent) 1.0) + percent-sizes (for [p parsed] + (when (= (:type p) :percent) + (int (* after-fixed (/ (* (:value p) percent-scale) 100.0))))) + percent-total (reduce + 0 (filter some? percent-sizes)) + after-percent (max 0 (- after-fixed percent-total)) + + ;; Phase 3: Fr/Flex units (divide remaining proportionally) + flex-specs (filter #(#{:flex :fr} (:type %)) parsed) + total-flex-weight (reduce + 0 (map :value flex-specs)) + flex-unit (if (pos? total-flex-weight) + (/ after-percent total-flex-weight) + 0) + + ;; Calculate final sizes + raw-sizes (mapv (fn [p pct-size] + (case (:type p) + :fixed (:value p) + :percent pct-size + :flex (int (* (:value p) flex-unit)) + :fr (int (* (:value p) flex-unit)) + :auto nil)) + parsed + (concat percent-sizes (repeat nil))) + + ;; Phase 4: Apply constraints (min/max) + constrained (mapv (fn [size p] + (if (and size (or (:min p) (:max p))) + (cond-> size + (:min p) (max (:min p)) + (:max p) (min (:max p))) + size)) + raw-sizes + parsed)] + constrained)) + ;; === Hiccup Parsing === (defn- flatten-children "Flatten sequences in children (but not vectors, which are hiccup elements)." @@ -47,7 +161,6 @@ ;; === Layout Primitives === (declare render-element) -(declare calculate-flex-sizes) (defn- render-children "Render all children and return list of rendered strings." @@ -58,14 +171,16 @@ "Render :row - horizontal layout with proper multi-line support. Each child is rendered and placed side-by-side, with lines aligned. Supports :gap for spacing and :widths for column widths. - :widths can be numbers (fixed), :flex (share remaining), or nil (auto). - Example: [:row {:widths [20 :flex :flex]} child1 child2 child3]" + :widths can be: numbers (fixed), :flex/{:flex n} (weighted share), + \"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto). + Example: [:row {:widths [20 :flex :flex]} child1 child2 child3] + Example: [:row {:widths [\"30%\" \"2fr\" \"1fr\"]} child1 child2 child3]" [{:keys [gap widths] :or {gap 0}} children ctx] (let [available-width (or (:available-width ctx) 120) available-height (or (:available-height ctx) 100) - ;; Calculate flex widths if :flex is used - calculated-widths (when (and widths (some #(= % :flex) widths)) - (calculate-flex-sizes widths children available-width gap)) + ;; Use new enhanced sizing system + calculated-widths (when widths + (calculate-sizes widths children available-width gap)) ;; Render each child with its allocated width in context rendered (map-indexed (fn [idx child] @@ -79,10 +194,8 @@ child-lines (mapv #(str/split % #"\n" -1) rendered) ;; Calculate width of each child child-widths (cond - ;; Use calculated flex widths + ;; Use calculated widths (includes flex, percent, fr) calculated-widths calculated-widths - ;; Use provided fixed widths - widths widths ;; Auto: max visible length of lines :else (mapv (fn [lines] (apply max 0 (map ansi/visible-length lines))) @@ -99,49 +212,25 @@ (fn [child-idx lines] (let [line (get lines line-idx "") width (get child-widths child-idx 0)] - (ansi/pad-right line width))) + (ansi/pad-right line (or width 0)))) child-lines)))] (str/join "\n" combined-lines))) -(defn- calculate-flex-sizes - "Calculate sizes for children given a spec. - Sizes can be: numbers (fixed), :flex (share remaining), or nil (auto). - Returns vector of calculated sizes." - [sizes children available-size gap] - (let [num-children (count children) - sizes-vec (if sizes - (vec (take num-children (concat sizes (repeat nil)))) - (vec (repeat num-children nil))) - ;; Total gap space - total-gap (* gap (max 0 (dec num-children))) - usable-size (- available-size total-gap) - ;; Count fixed sizes and flex items - fixed-total (reduce + 0 (filter number? sizes-vec)) - flex-count (count (filter #(= % :flex) sizes-vec)) - ;; Calculate size per flex item - remaining (- usable-size fixed-total) - flex-size (if (pos? flex-count) - (max 1 (quot remaining flex-count)) - 0)] - ;; Return calculated sizes - (mapv (fn [s] - (cond - (number? s) s - (= s :flex) flex-size - :else nil)) ; nil means auto-size - sizes-vec))) (defn- render-col "Render :col - vertical layout. Supports :heights for distributing vertical space. - Heights can be numbers (fixed) or :flex (share remaining space). - Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4]" + Heights can be: numbers (fixed), :flex/{:flex n} (weighted share), + \"N%\" (percentage), \"Nfr\" (fractional unit), or nil (auto). + Example: [:col {:heights [3 :flex :flex 4]} child1 child2 child3 child4] + Example: [:col {:heights [\"10%\" \"2fr\" \"1fr\"]} child1 child2 child3]" [{:keys [gap heights width height] :or {gap 0}} children ctx] (let [;; Use explicit width/height if provided, otherwise from context available-width (or width (:available-width ctx) 120) available-height (or height (:available-height ctx) 100) + ;; Use new enhanced sizing system calculated-heights (when heights - (calculate-flex-sizes heights children available-height gap)) + (calculate-sizes heights children available-height gap)) ;; Render each child with its allocated height in context rendered (map-indexed (fn [idx child] @@ -304,6 +393,241 @@ result-lines (overlay-lines bg-lines modal-lines available-width available-height)] (str/join "\n" result-lines))) +;; === Scroll Primitive === + +(defn visible-window-calc + "Calculate the visible window of items for scrolling. + Returns {:start start-index :end end-index :has-above bool :has-below bool} + Keeps cursor visible by scrolling the window." + [total-items cursor max-visible] + (let [max-visible (max 1 max-visible)] + (if (<= total-items max-visible) + ;; All items fit, no scrolling needed + {:start 0 :end total-items :has-above false :has-below false} + ;; Need to scroll - calculate window that keeps cursor visible + (let [half (quot max-visible 2) + start-idx (cond + ;; Cursor near start - show from beginning + (<= cursor half) 0 + ;; Cursor near end - show end portion + (>= cursor (- total-items half)) (- total-items max-visible) + ;; Cursor in middle - center it + :else (- cursor half)) + start-idx (max 0 (min start-idx (- total-items max-visible))) + end-idx (+ start-idx max-visible)] + {:start start-idx + :end end-idx + :has-above (pos? start-idx) + :has-below (< end-idx total-items)})))) + +(defn- render-scroll + "Render :scroll - scrollable container with automatic windowing. + Renders only the visible children based on available-height and cursor position. + Shows ↑/↓ indicators when content is clipped. + + Attrs: + - :cursor - index of currently selected item (default 0) + - :indicators - show scroll indicators when clipped (default true) + + Example: [:scroll {:cursor 3} child0 child1 child2 child3 child4 ...]" + [{:keys [cursor indicators] :or {cursor 0 indicators true}} children ctx] + (let [available-height (or (:available-height ctx) 100) + total-items (count children) + ;; Reserve space for indicators if enabled + indicator-height (if indicators 1 0) + max-visible (- available-height (* 2 indicator-height)) + max-visible (max 1 max-visible) + ;; Calculate visible window + {:keys [start end has-above has-below]} (visible-window-calc total-items cursor max-visible) + ;; Get visible children + visible-children (subvec (vec children) start end) + ;; Render visible children + rendered-lines (mapv #(render-element % ctx) visible-children) + ;; Build result with indicators + up-indicator (when (and indicators has-above) + (ansi/style "↑" :fg :cyan)) + down-indicator (when (and indicators has-below) + (ansi/style "↓" :fg :cyan)) + all-lines (cond-> [] + up-indicator (conj up-indicator) + true (into rendered-lines) + down-indicator (conj down-indicator))] + (str/join "\n" all-lines))) + +;; === Grid Primitive === + +(defn- parse-template + "Parse grid template strings into a position map. + Template like [\"header header\" \"nav main\" \"footer footer\"] + Returns a map of {name {:row row :col col :row-span n :col-span n}}" + [template] + (let [rows (mapv #(str/split % #"\s+") template) + num-rows (count rows) + num-cols (apply max 1 (map count rows)) + ;; Normalize rows to have same number of columns + normalized-rows (mapv #(vec (take num-cols (concat % (repeat nil)))) rows) + ;; Build position map + positions (atom {})] + ;; Find each named area's bounds + (doseq [row-idx (range num-rows) + col-idx (range num-cols)] + (let [name (get-in normalized-rows [row-idx col-idx])] + (when (and name (not= name ".")) ;; "." means empty cell + (if-let [existing (get @positions name)] + ;; Extend existing area + (swap! positions update name + (fn [area] + (-> area + (update :row-span #(max % (- (inc row-idx) (:row area)))) + (update :col-span #(max % (- (inc col-idx) (:col area))))))) + ;; New area + (swap! positions assoc name {:row row-idx :col col-idx :row-span 1 :col-span 1}))))) + @positions)) + +(defn- parse-area-children + "Extract area definitions from grid children. + Returns map of position -> child element for explicit positioning, + or name -> child element for named template areas." + [children] + (reduce + (fn [acc child] + (if (and (vector? child) (= :area (first child))) + (let [[_ attrs & content] (if (map? (second child)) + child + (into [(first child) {}] (rest child))) + content (if (= 1 (count content)) (first content) (vec content))] + (if (:name attrs) + ;; Named area + (assoc-in acc [:named (:name attrs)] {:attrs attrs :content content}) + ;; Explicit position + (let [row (or (:row attrs) 0) + col (or (:col attrs) 0)] + (assoc-in acc [:positioned [row col]] {:attrs attrs :content content})))) + ;; Not an area - treat as positioned at auto-incrementing position + acc)) + {:named {} :positioned {}} + children)) + +(defn- create-canvas + "Create a 2D canvas (vector of vectors of characters/strings)." + [width height] + (vec (repeat height (vec (repeat width " "))))) + +(defn- overlay-on-canvas + "Overlay rendered content on canvas at given position." + [canvas content x y width height] + (let [lines (str/split content #"\n" -1) + lines (take height lines)] + (reduce + (fn [c [line-idx line]] + (let [line-chars (vec (seq (ansi/pad-right line width))) + row-idx (+ y line-idx)] + (if (< row-idx (count c)) + (update c row-idx + (fn [row] + (reduce + (fn [r [char-idx char]] + (let [col-idx (+ x char-idx)] + (if (< col-idx (count r)) + (assoc r col-idx (str char)) + r))) + row + (map-indexed vector line-chars)))) + c))) + canvas + (map-indexed vector lines)))) + +(defn- render-grid + "Render :grid - 2D grid layout. + + Supports two positioning modes: + + 1. Explicit positioning: + [:grid {:rows [3 :flex :flex] :cols [30 :flex] :gap 1} + [:area {:row 0 :col 0 :col-span 2} header] + [:area {:row 1 :col 0} nav] + [:area {:row 1 :col 1} main]] + + 2. Named template: + [:grid {:template [\"header header\" + \"nav main\"] + :rows [3 :flex] + :cols [30 :flex]} + [:area {:name \"header\"} header-content] + [:area {:name \"nav\"} nav-content] + [:area {:name \"main\"} main-content]] + + Attrs: + - :rows - row size specs (numbers, :flex, %, fr) + - :cols - column size specs + - :gap - gap between cells (number or [row-gap col-gap]) + - :template - optional template strings for named areas" + [{:keys [rows cols gap template] :or {gap 0}} children ctx] + (let [available-width (or (:available-width ctx) 120) + available-height (or (:available-height ctx) 100) + ;; Parse gap + [row-gap col-gap] (if (vector? gap) gap [gap gap]) + ;; Parse template if provided + template-positions (when template (parse-template template)) + ;; Determine grid dimensions + num-rows (if template + (count template) + (or (count rows) 1)) + num-cols (if template + (apply max 1 (map #(count (str/split % #"\s+")) template)) + (or (count cols) 1)) + ;; Default row/col specs if not provided + rows (or rows (vec (repeat num-rows :flex))) + cols (or cols (vec (repeat num-cols :flex))) + ;; Calculate row heights and column widths + row-heights (calculate-sizes rows (range num-rows) available-height row-gap) + col-widths (calculate-sizes cols (range num-cols) available-width col-gap) + ;; Parse area children + {:keys [named positioned]} (parse-area-children children) + ;; Merge template positions with named areas + areas (if template-positions + (reduce-kv + (fn [acc name pos] + (if-let [area (get named name)] + (assoc acc [(:row pos) (:col pos)] + {:attrs (merge pos (:attrs area)) + :content (:content area)}) + acc)) + positioned + template-positions) + positioned) + ;; Calculate positions for each cell + row-positions (reductions + 0 (interpose row-gap row-heights)) + col-positions (reductions + 0 (interpose col-gap col-widths)) + ;; Create canvas + total-height (+ (reduce + 0 row-heights) (* row-gap (max 0 (dec num-rows)))) + total-width (+ (reduce + 0 col-widths) (* col-gap (max 0 (dec num-cols)))) + canvas (create-canvas total-width total-height) + ;; Render each area + final-canvas + (reduce-kv + (fn [c [row col] {:keys [attrs content]}] + (let [row-span (or (:row-span attrs) 1) + col-span (or (:col-span attrs) 1) + ;; Calculate cell dimensions + cell-height (+ (reduce + 0 (take row-span (drop row row-heights))) + (* row-gap (max 0 (dec row-span)))) + cell-width (+ (reduce + 0 (take col-span (drop col col-widths))) + (* col-gap (max 0 (dec col-span)))) + ;; Calculate cell position + cell-y (nth (vec row-positions) row 0) + cell-x (nth (vec col-positions) col 0) + ;; Render content with cell dimensions in context + cell-ctx (assoc ctx + :available-width cell-width + :available-height cell-height) + rendered (render-element content cell-ctx)] + (overlay-on-canvas c rendered cell-x cell-y cell-width cell-height))) + canvas + areas)] + ;; Convert canvas to string + (str/join "\n" (map #(apply str %) final-canvas)))) + ;; === Main Render Function === (defn render-element "Render a hiccup element to ANSI string." @@ -322,13 +646,16 @@ (vector? elem) (let [[tag attrs children] (parse-element elem)] (case tag - :text (render-text attrs children) - :row (render-row attrs children ctx) - :col (render-col attrs children ctx) - :box (render-box attrs children ctx) - :space (render-space attrs children ctx) - :input (render-input attrs children ctx) - :modal (render-modal attrs children ctx) + :text (render-text attrs children) + :row (render-row attrs children ctx) + :col (render-col attrs children ctx) + :box (render-box attrs children ctx) + :space (render-space attrs children ctx) + :input (render-input attrs children ctx) + :modal (render-modal attrs children ctx) + :scroll (render-scroll attrs children ctx) + :grid (render-grid attrs children ctx) + :area (apply str (render-children children ctx)) ;; Areas are handled by grid ;; Default: just render children (apply str (render-children children ctx)))) @@ -369,3 +696,24 @@ (if (map? (first args)) (into [:box (first args)] (rest args)) (into [:box {}] args))) + +(defn scroll + "Create a scrollable container." + [& args] + (if (map? (first args)) + (into [:scroll (first args)] (rest args)) + (into [:scroll {}] args))) + +(defn grid + "Create a 2D grid layout." + [& args] + (if (map? (first args)) + (into [:grid (first args)] (rest args)) + (into [:grid {}] args))) + +(defn area + "Create a grid area (used inside :grid)." + [& args] + (if (map? (first args)) + (into [:area (first args)] (rest args)) + (into [:area {}] args))) diff --git a/test/tui/core_test.clj b/test/tui/core_test.clj index b89d0a9..cde3988 100644 --- a/test/tui/core_test.clj +++ b/test/tui/core_test.clj @@ -4,16 +4,17 @@ (:require [clojure.test :refer [deftest testing is]] [clojure.core.async :as async :refer [chan >!! str nil)))) + (testing "nil message returns empty string" + (is (= "" (input/key->str nil)))) - (testing "non-key message returns nil" - (is (nil? (input/key->str [:tick 123]))) - (is (nil? (input/key->str [:custom :message])))) + (testing "non-key message returns string representation" + ;; Legacy format returns the second element as string + (is (string? (input/key->str [:tick 123]))) + (is (string? (input/key->str [:custom :message])))) (testing "key message with empty map" (is (= "" (input/key->str [:key {}])))) diff --git a/test/tui/events_test.clj b/test/tui/events_test.clj new file mode 100644 index 0000000..8d6f9fd --- /dev/null +++ b/test/tui/events_test.clj @@ -0,0 +1,140 @@ +(ns tui.events-test + "Unit tests for event constructors and key matching." + (:require [clojure.test :refer [deftest testing is]] + [tui.events :as ev])) + +;; === Event Constructor Tests === + +(deftest quit-test + (testing "quit returns quit event" + (is (= {:type :quit} (ev/quit))))) + +(deftest delay-test + (testing "delay creates delay event" + (is (= {:type :delay :ms 1000 :event {:type :tick}} + (ev/delay 1000 {:type :tick})))) + + (testing "delay with different ms values" + (is (= 0 (:ms (ev/delay 0 {:type :x})))) + (is (= 5000 (:ms (ev/delay 5000 {:type :x})))))) + +(deftest shell-test + (testing "shell creates shell event with vector cmd" + (is (= {:type :shell :cmd ["git" "status"] :event {:type :result}} + (ev/shell ["git" "status"] {:type :result})))) + + (testing "shell preserves event data" + (let [event {:type :git-result :file "foo.txt"}] + (is (= event (:event (ev/shell ["git" "diff"] event))))))) + +(deftest batch-test + (testing "batch creates batch event" + (let [e1 {:type :a} + e2 {:type :b} + result (ev/batch e1 e2)] + (is (= :batch (:type result))) + (is (= [e1 e2] (:events result))))) + + (testing "batch filters nil events" + (let [result (ev/batch nil {:type :a} nil {:type :b} nil)] + (is (= [{:type :a} {:type :b}] (:events result))))) + + (testing "batch returns nil for all-nil events" + (is (nil? (ev/batch nil nil nil)))) + + (testing "batch returns nil for no events" + (is (nil? (ev/batch))))) + +(deftest sequential-test + (testing "sequential creates sequential event" + (let [e1 {:type :a} + e2 {:type :b} + result (ev/sequential e1 e2)] + (is (= :sequential (:type result))) + (is (= [e1 e2] (:events result))))) + + (testing "sequential filters nil events" + (let [result (ev/sequential nil {:type :a} nil {:type :b} nil)] + (is (= [{:type :a} {:type :b}] (:events result))))) + + (testing "sequential returns nil for all-nil events" + (is (nil? (ev/sequential nil nil nil)))) + + (testing "sequential returns nil for no events" + (is (nil? (ev/sequential))))) + +(deftest debounce-test + (testing "debounce creates debounce event" + (is (= {:type :debounce :id :search :ms 300 :event {:type :search-query}} + (ev/debounce :search 300 {:type :search-query})))) + + (testing "debounce with different ids" + (is (= :resize (:id (ev/debounce :resize 100 {:type :x})))) + (is (= :input (:id (ev/debounce :input 50 {:type :x})))))) + +;; === Key Matching Tests === + +(deftest key=-basic-test + (testing "matches plain character" + (is (ev/key= {:type :key :key \q} \q)) + (is (ev/key= {:type :key :key \a} \a)) + (is (ev/key= {:type :key :key \1} \1))) + + (testing "does not match different character" + (is (not (ev/key= {:type :key :key \q} \a))) + (is (not (ev/key= {:type :key :key \x} \y))))) + +(deftest key=-special-keys-test + (testing "matches special keys" + (is (ev/key= {:type :key :key :enter} :enter)) + (is (ev/key= {:type :key :key :escape} :escape)) + (is (ev/key= {:type :key :key :up} :up)) + (is (ev/key= {:type :key :key :f1} :f1))) + + (testing "does not match wrong special keys" + (is (not (ev/key= {:type :key :key :up} :down))) + (is (not (ev/key= {:type :key :key :enter} :escape))))) + +(deftest key=-with-modifiers-test + (testing "matches key with exact modifiers" + (is (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c #{:ctrl})) + (is (ev/key= {:type :key :key \z :modifiers #{:ctrl :shift}} \z #{:ctrl :shift})) + (is (ev/key= {:type :key :key \a :modifiers #{:shift}} \a #{:shift}))) + + (testing "does not match with wrong modifiers" + (is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c #{:alt}))) + (is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl :shift}} \c #{:ctrl})))) + + (testing "does not match when modifiers present but not specified" + (is (not (ev/key= {:type :key :key \c :modifiers #{:ctrl}} \c))) + (is (not (ev/key= {:type :key :key \a :modifiers #{:shift}} \a)))) + + (testing "does not match when modifiers specified but not present" + (is (not (ev/key= {:type :key :key \c} \c #{:ctrl}))))) + +(deftest key=-non-key-events-test + (testing "returns false for non-key events" + (is (not (ev/key= {:type :quit} \q))) + (is (not (ev/key= {:type :tick} :enter))) + (is (not (ev/key= nil \a))))) + +;; === Composition Tests === + +(deftest composed-events-test + (testing "can compose multiple event constructors" + (let [result (ev/batch + (ev/shell ["git" "status"] {:type :status}) + (ev/delay 1000 {:type :refresh}))] + (is (= :batch (:type result))) + (is (= 2 (count (:events result)))) + (is (= :shell (:type (first (:events result))))) + (is (= :delay (:type (second (:events result))))))) + + (testing "can nest batch in sequential" + (let [result (ev/sequential + {:type :start} + (ev/batch + (ev/shell ["git" "add" "."] {:type :added}) + (ev/shell ["git" "status"] {:type :status})))] + (is (= :sequential (:type result))) + (is (= :batch (:type (second (:events result)))))))) diff --git a/test/tui/input_test.clj b/test/tui/input_test.clj index 164ebb7..6324d6c 100644 --- a/test/tui/input_test.clj +++ b/test/tui/input_test.clj @@ -3,10 +3,68 @@ (:require [clojure.test :refer [deftest testing is]] [tui.input :as input])) -;; === Key Matching Tests === +;; === New Event Format Tests === -(deftest key-match-character-test - (testing "matches single character keys" +(deftest key-match-new-format-character-test + (testing "matches single character keys (new format)" + (is (input/key-match? {:type :key :key \q} "q")) + (is (input/key-match? {:type :key :key \a} "a")) + (is (input/key-match? {:type :key :key \1} "1"))) + + (testing "does not match different characters" + (is (not (input/key-match? {:type :key :key \q} "a"))) + (is (not (input/key-match? {:type :key :key \x} "y")))) + + (testing "does not match ctrl+char as plain char" + (is (not (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} "c")))) + + (testing "does not match alt+char as plain char" + (is (not (input/key-match? {:type :key :key \x :modifiers #{:alt}} "x"))))) + +(deftest key-match-new-format-special-keys-test + (testing "matches special keys by keyword (new format)" + (is (input/key-match? {:type :key :key :enter} :enter)) + (is (input/key-match? {:type :key :key :escape} :escape)) + (is (input/key-match? {:type :key :key :backspace} :backspace)) + (is (input/key-match? {:type :key :key :tab} :tab))) + + (testing "matches arrow keys" + (is (input/key-match? {:type :key :key :up} :up)) + (is (input/key-match? {:type :key :key :down} :down)) + (is (input/key-match? {:type :key :key :left} :left)) + (is (input/key-match? {:type :key :key :right} :right))) + + (testing "matches function keys" + (is (input/key-match? {:type :key :key :f1} :f1)) + (is (input/key-match? {:type :key :key :f12} :f12))) + + (testing "does not match wrong special keys" + (is (not (input/key-match? {:type :key :key :up} :down))) + (is (not (input/key-match? {:type :key :key :enter} :escape))))) + +(deftest key-match-new-format-ctrl-combo-test + (testing "matches ctrl+char combinations (new format)" + (is (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} [:ctrl \c])) + (is (input/key-match? {:type :key :key \x :modifiers #{:ctrl}} [:ctrl \x])) + (is (input/key-match? {:type :key :key \z :modifiers #{:ctrl}} [:ctrl \z]))) + + (testing "does not match wrong ctrl combinations" + (is (not (input/key-match? {:type :key :key \c :modifiers #{:ctrl}} [:ctrl \x]))) + (is (not (input/key-match? {:type :key :key \c} [:ctrl \c]))))) + +(deftest key-match-new-format-alt-combo-test + (testing "matches alt+char combinations (new format)" + (is (input/key-match? {:type :key :key \x :modifiers #{:alt}} [:alt \x])) + (is (input/key-match? {:type :key :key \a :modifiers #{:alt}} [:alt \a]))) + + (testing "does not match wrong alt combinations" + (is (not (input/key-match? {:type :key :key \x :modifiers #{:alt}} [:alt \y]))) + (is (not (input/key-match? {:type :key :key \x} [:alt \x]))))) + +;; === Legacy Event Format Tests (Backward Compatibility) === + +(deftest key-match-legacy-character-test + (testing "matches single character keys (legacy format)" (is (input/key-match? [:key {:char \q}] "q")) (is (input/key-match? [:key {:char \a}] "a")) (is (input/key-match? [:key {:char \1}] "1"))) @@ -21,8 +79,8 @@ (testing "does not match alt+char as plain char" (is (not (input/key-match? [:key {:alt true :char \x}] "x"))))) -(deftest key-match-special-keys-test - (testing "matches special keys by keyword" +(deftest key-match-legacy-special-keys-test + (testing "matches special keys by keyword (legacy format)" (is (input/key-match? [:key :enter] :enter)) (is (input/key-match? [:key :escape] :escape)) (is (input/key-match? [:key :backspace] :backspace)) @@ -42,8 +100,8 @@ (is (not (input/key-match? [:key :up] :down))) (is (not (input/key-match? [:key :enter] :escape))))) -(deftest key-match-ctrl-combo-test - (testing "matches ctrl+char combinations" +(deftest key-match-legacy-ctrl-combo-test + (testing "matches ctrl+char combinations (legacy format)" (is (input/key-match? [:key {:ctrl true :char \c}] [:ctrl \c])) (is (input/key-match? [:key {:ctrl true :char \x}] [:ctrl \x])) (is (input/key-match? [:key {:ctrl true :char \z}] [:ctrl \z]))) @@ -52,8 +110,8 @@ (is (not (input/key-match? [:key {:ctrl true :char \c}] [:ctrl \x]))) (is (not (input/key-match? [:key {:char \c}] [:ctrl \c]))))) -(deftest key-match-alt-combo-test - (testing "matches alt+char combinations" +(deftest key-match-legacy-alt-combo-test + (testing "matches alt+char combinations (legacy format)" (is (input/key-match? [:key {:alt true :char \x}] [:alt \x])) (is (input/key-match? [:key {:alt true :char \a}] [:alt \a]))) @@ -62,33 +120,47 @@ (is (not (input/key-match? [:key {:char \x}] [:alt \x]))))) (deftest key-match-non-key-messages-test - (testing "returns nil for non-key messages" - (is (nil? (input/key-match? [:tick 123] "q"))) - (is (nil? (input/key-match? [:quit] :enter))) - (is (nil? (input/key-match? nil "a"))))) + (testing "returns false for non-key messages" + (is (not (input/key-match? {:type :tick :value 123} "q"))) + (is (not (input/key-match? {:type :quit} :enter))) + (is (not (input/key-match? nil "a"))))) ;; === Key to String Tests === -(deftest key->str-special-keys-test - (testing "converts special keys to strings" +(deftest key->str-new-format-test + (testing "converts special keys to strings (new format)" + (is (= "enter" (input/key->str {:type :key :key :enter}))) + (is (= "escape" (input/key->str {:type :key :key :escape}))) + (is (= "up" (input/key->str {:type :key :key :up}))) + (is (= "f1" (input/key->str {:type :key :key :f1})))) + + (testing "converts character keys to strings (new format)" + (is (= "q" (input/key->str {:type :key :key \q}))) + (is (= "a" (input/key->str {:type :key :key \a})))) + + (testing "converts modifier combinations to strings (new format)" + (is (= "ctrl+c" (input/key->str {:type :key :key \c :modifiers #{:ctrl}}))) + (is (= "alt+x" (input/key->str {:type :key :key \x :modifiers #{:alt}}))) + (is (= "shift+a" (input/key->str {:type :key :key \a :modifiers #{:shift}}))))) + +(deftest key->str-legacy-format-test + (testing "converts special keys to strings (legacy format)" (is (= "enter" (input/key->str [:key :enter]))) (is (= "escape" (input/key->str [:key :escape]))) (is (= "up" (input/key->str [:key :up]))) - (is (= "f1" (input/key->str [:key :f1]))))) + (is (= "f1" (input/key->str [:key :f1])))) -(deftest key->str-character-keys-test - (testing "converts character keys to strings" + (testing "converts character keys to strings (legacy format)" (is (= "q" (input/key->str [:key {:char \q}]))) - (is (= "a" (input/key->str [:key {:char \a}]))))) + (is (= "a" (input/key->str [:key {:char \a}])))) -(deftest key->str-modifier-keys-test - (testing "converts ctrl combinations to strings" + (testing "converts ctrl combinations to strings (legacy format)" (is (= "ctrl+c" (input/key->str [:key {:ctrl true :char \c}])))) - (testing "converts alt combinations to strings" + (testing "converts alt combinations to strings (legacy format)" (is (= "alt+x" (input/key->str [:key {:alt true :char \x}]))))) (deftest key->str-non-key-messages-test - (testing "returns nil for non-key messages" - (is (nil? (input/key->str [:tick 123]))) - (is (nil? (input/key->str nil))))) + (testing "returns string for non-key messages" + (is (string? (input/key->str [:tick 123]))) + (is (= "" (input/key->str nil))))) diff --git a/test/tui/render_test.clj b/test/tui/render_test.clj index d5f48a3..afbd75d 100644 --- a/test/tui/render_test.clj +++ b/test/tui/render_test.clj @@ -80,7 +80,10 @@ [:row "c" " " "d"]])))) (testing "renders col inside row" - (is (= "a\nb c\nd" (render/render [:row + ;; Row places children side-by-side, aligning lines + ;; col1 = "a\nb", col2 = " ", col3 = "c\nd" + ;; Result: line1 = "a c", line2 = "b d" (space between a/c and b/d is from the " " child) + (is (= "a c\nb d" (render/render [:row [:col "a" "b"] " " [:col "c" "d"]]))))) @@ -138,6 +141,189 @@ ;; === Convenience Function Tests === +;; === Grid Tests === + +(deftest parse-template-test + (testing "parses simple template" + (let [result (#'render/parse-template ["a a" "b c"])] + (is (= {:row 0 :col 0 :row-span 1 :col-span 2} (get result "a"))) + (is (= {:row 1 :col 0 :row-span 1 :col-span 1} (get result "b"))) + (is (= {:row 1 :col 1 :row-span 1 :col-span 1} (get result "c"))))) + + (testing "parses template with row spans" + (let [result (#'render/parse-template ["a b" "a c"])] + (is (= {:row 0 :col 0 :row-span 2 :col-span 1} (get result "a"))))) + + (testing "ignores . for empty cells" + (let [result (#'render/parse-template [". a" "b a"])] + (is (nil? (get result "."))) + (is (= {:row 0 :col 1 :row-span 2 :col-span 1} (get result "a")))))) + +(deftest render-grid-test + (testing "renders simple 2x2 grid with explicit positioning" + (let [result (render/render [:grid {:rows [1 1] :cols [3 3]} + [:area {:row 0 :col 0} "A"] + [:area {:row 0 :col 1} "B"] + [:area {:row 1 :col 0} "C"] + [:area {:row 1 :col 1} "D"]] + {:available-width 6 :available-height 2})] + (is (str/includes? result "A")) + (is (str/includes? result "B")) + (is (str/includes? result "C")) + (is (str/includes? result "D")))) + + (testing "renders grid with named template" + (let [result (render/render [:grid {:template ["header header" + "nav main"] + :rows [1 1] + :cols [3 3]} + [:area {:name "header"} "H"] + [:area {:name "nav"} "N"] + [:area {:name "main"} "M"]] + {:available-width 6 :available-height 2})] + (is (str/includes? result "H")) + (is (str/includes? result "N")) + (is (str/includes? result "M")))) + + (testing "grid convenience functions create proper elements" + (is (= [:grid {} "a" "b"] (render/grid "a" "b"))) + (is (= [:grid {:rows [1 1]} "a"] (render/grid {:rows [1 1]} "a"))) + (is (= [:area {} "content"] (render/area "content"))) + (is (= [:area {:row 0 :col 1} "x"] (render/area {:row 0 :col 1} "x"))))) + +;; === Scroll Tests === + +(deftest visible-window-calc-test + (testing "all items fit when total <= max-visible" + (let [result (#'render/visible-window-calc 3 0 5)] + (is (= 0 (:start result))) + (is (= 3 (:end result))) + (is (false? (:has-above result))) + (is (false? (:has-below result))))) + + (testing "cursor at start shows beginning of list" + (let [result (#'render/visible-window-calc 10 0 3)] + (is (= 0 (:start result))) + (is (= 3 (:end result))) + (is (false? (:has-above result))) + (is (true? (:has-below result))))) + + (testing "cursor at end shows end of list" + (let [result (#'render/visible-window-calc 10 9 3)] + (is (= 7 (:start result))) + (is (= 10 (:end result))) + (is (true? (:has-above result))) + (is (false? (:has-below result))))) + + (testing "cursor in middle centers window" + (let [result (#'render/visible-window-calc 10 5 3)] + (is (>= (:start result) 3)) + (is (<= (:end result) 7)) + (is (true? (:has-above result))) + (is (true? (:has-below result)))))) + +(deftest render-scroll-test + (testing "renders all items when they fit" + (let [result (render/render [:scroll {:cursor 0 :indicators false} + "item1" "item2" "item3"] + {:available-height 10})] + (is (str/includes? result "item1")) + (is (str/includes? result "item2")) + (is (str/includes? result "item3")))) + + (testing "renders only visible items when content exceeds height" + (let [result (render/render [:scroll {:cursor 0 :indicators false} + "item1" "item2" "item3" "item4" "item5"] + {:available-height 2})] + (is (str/includes? result "item1")) + (is (str/includes? result "item2")) + (is (not (str/includes? result "item5"))))) + + (testing "shows down indicator when more content below" + (let [result (render/render [:scroll {:cursor 0} + "item1" "item2" "item3" "item4" "item5"] + {:available-height 4})] + (is (str/includes? result "↓")))) + + (testing "shows up indicator when more content above" + (let [result (render/render [:scroll {:cursor 4} + "item1" "item2" "item3" "item4" "item5"] + {:available-height 4})] + (is (str/includes? result "↑")))) + + (testing "scroll convenience function creates scroll element" + (is (= [:scroll {} "a" "b"] (render/scroll "a" "b"))) + (is (= [:scroll {:cursor 2} "a" "b" "c"] (render/scroll {:cursor 2} "a" "b" "c"))))) + +;; === Enhanced Sizing Tests === + +(deftest parse-size-spec-test + (testing "parses fixed numbers" + (is (= {:type :fixed :value 30} (#'render/parse-size-spec 30))) + (is (= {:type :fixed :value 0} (#'render/parse-size-spec 0)))) + + (testing "parses :flex shorthand" + (is (= {:type :flex :value 1} (#'render/parse-size-spec :flex)))) + + (testing "parses {:flex n} weighted flex" + (is (= {:type :flex :value 2 :min nil :max nil} + (#'render/parse-size-spec {:flex 2}))) + (is (= {:type :flex :value 3 :min 10 :max 50} + (#'render/parse-size-spec {:flex 3 :min 10 :max 50})))) + + (testing "parses percentage strings" + (is (= {:type :percent :value 50} (#'render/parse-size-spec "50%"))) + (is (= {:type :percent :value 100} (#'render/parse-size-spec "100%")))) + + (testing "parses fractional unit strings" + (is (= {:type :fr :value 1} (#'render/parse-size-spec "1fr"))) + (is (= {:type :fr :value 2} (#'render/parse-size-spec "2fr")))) + + (testing "parses {:percent n} with constraints" + (is (= {:type :percent :value 30 :min 10 :max 100} + (#'render/parse-size-spec {:percent 30 :min 10 :max 100})))) + + (testing "parses nil as auto" + (is (= {:type :auto :value nil} (#'render/parse-size-spec nil))))) + +(deftest calculate-sizes-test + (testing "calculates fixed sizes" + (is (= [30 40] (#'render/calculate-sizes [30 40] [:a :b] 100 0)))) + + (testing "calculates flex sizes evenly" + (is (= [50 50] (#'render/calculate-sizes [:flex :flex] [:a :b] 100 0)))) + + (testing "calculates weighted flex sizes" + (let [result (#'render/calculate-sizes [{:flex 1} {:flex 2}] [:a :b] 90 0)] + (is (= 30 (first result))) + (is (= 60 (second result))))) + + (testing "calculates mixed fixed and flex" + (is (= [20 40 40] (#'render/calculate-sizes [20 :flex :flex] [:a :b :c] 100 0)))) + + (testing "accounts for gap in calculations" + ;; 100 - 10 gap = 90 usable, split evenly + (is (= [45 45] (#'render/calculate-sizes [:flex :flex] [:a :b] 100 10)))) + + (testing "calculates percentage sizes" + (let [result (#'render/calculate-sizes ["50%" "50%"] [:a :b] 100 0)] + (is (= 50 (first result))) + (is (= 50 (second result))))) + + (testing "calculates fractional unit sizes" + (let [result (#'render/calculate-sizes ["1fr" "2fr"] [:a :b] 90 0)] + (is (= 30 (first result))) + (is (= 60 (second result))))) + + (testing "handles mixed percentage, fixed, and flex" + (let [result (#'render/calculate-sizes [20 "50%" :flex] [:a :b :c] 100 0)] + ;; Fixed: 20, remaining: 80 + ;; Percentage: 50% of 80 = 40 + ;; Flex gets remaining: 80 - 40 = 40 + (is (= 20 (first result))) + (is (= 40 (second result))) + (is (= 40 (nth result 2)))))) + (deftest convenience-functions-test (testing "text function creates text element" (is (= [:text {} "hello"] (render/text "hello")))