v0.8.0: Information Radiator, Command Palette, TrueColor Themes, Setup Wizard
- Sidebar: permanent 42-col panel with 7 data panels (Gate Trace, Focus, Rules, Context gauge, Files, Cost, Protection); 4-window Croatoan layout at >=120 cols, toggle via Ctrl+X+B - Command palette: Ctrl+P overlay with fuzzy-filtered categorized items, keyboard navigation, Enter to execute; view-palette rendering - TrueColor themes: 4 new presets (nord, tokyonight, catppuccin, monokai) with 27 hex keys via theme-hex-to-rgb - Setup wizard: Ctrl+\ /setup 4-step overlay (provider, key, memory, save) writing .env with in-TUI rendering - Daemon enrichment: dispatcher block counts, cost session summary, modified files tracking, context usage percentage - Daemon fixes: fboundp guards for count-tokens/provider-token-cost, tool registry save/restore in safety tests, SELF_BUILD_MODE cleanup - 139 tests pass across all suites (0 failures)
This commit is contained in:
@@ -5,6 +5,62 @@
|
||||
|
||||
Event handlers + daemon I/O + main loop.
|
||||
|
||||
** v0.8.0 — Sidebar Controller
|
||||
|
||||
The sidebar toggles via ~/sidebar~ command or ~Ctrl+X+B~ chord. The
|
||||
~Ctrl+X~ prefix sets ~:pending-ctrl-x~ (existing infrastructure from
|
||||
v0.7.0); ~Ctrl+B~ on the next keystroke toggles ~:sidebar-visible~ and
|
||||
sets dirty flags to force redraw.
|
||||
|
||||
The sidebar's visibility depends on terminal width. At ≥ 120 columns,
|
||||
the sidebar is a permanent fourth Croatoan window in a 4-column layout
|
||||
(sidebar | content). At < 120 columns, the layout stays 3-window
|
||||
(status | chat | input) and the sidebar renders as an overlay when
|
||||
toggled, drawn as an absolute-positioned window on top of the chat area.
|
||||
|
||||
The KEY_RESIZE handler in ~tui-main~ recomputes the layout: at ≥ 120
|
||||
columns it creates the 4-window layout; at < 120 it drops back to
|
||||
3-window and defers sidebar rendering to the overlay path.
|
||||
|
||||
** v0.8.0 — Command Palette Controller
|
||||
|
||||
~Ctrl+P~ opens the palette (sets ~:palette-visible~ to t, builds the
|
||||
categorized item list via ~palette-items~, resets ~:palette-filter~
|
||||
to empty string, sets ~:palette-selected-idx~ to 0). Subsequent
|
||||
keypresses route through ~on-key-palette~:
|
||||
|
||||
- Printable characters → append to filter, re-filter ~:palette-items~
|
||||
via ~palette-filter~, reset selection to 0
|
||||
- Up/Down → decrement/increment ~:palette-selected-idx~, clamp to bounds
|
||||
- Enter → execute ~palette-execute~ on selected item, dismiss palette
|
||||
- Esc → dismiss palette without action
|
||||
- Ctrl+P again → toggle dismiss
|
||||
|
||||
The palette items are defined in ~palette-items~ as a function returning
|
||||
a categorized list. Each item carries its ~:name~ (display), ~:desc~
|
||||
(tooltip), ~:shortcut~ (hint), and ~:action~ (a function of zero
|
||||
arguments that sends the appropriate message or executes the command).
|
||||
This design avoids duplicating command dispatch logic — palette actions
|
||||
reuse the same ~send-daemon~ / ~add-msg~ / ~theme-switch~ calls that
|
||||
~on-key~ uses.
|
||||
|
||||
** v0.8.0 — Setup Wizard Controller
|
||||
|
||||
The TUI setup wizard uses the same overlay window pattern as the palette.
|
||||
~wizard-steps~ returns the ordered list of configuration steps (provider
|
||||
selection, API key entry, connection verification, preferences). The
|
||||
current step index is stored in ~:wizard-step~.
|
||||
|
||||
~wizard-next~ runs the current step's ~:validate~ function on the input
|
||||
buffer. On pass, it increments ~:wizard-step~ and clears the input buffer.
|
||||
On fail, it sets ~:wizard-error~ with the error message and stays on the
|
||||
current step. The last step writes to ~.env~ and calls ~/reconnect~
|
||||
to reload daemon configuration.
|
||||
|
||||
The wizard cancels on Esc (with confirmation) and resumes where left off
|
||||
if the user reopens it within the same session. State is per-session only
|
||||
— no disk persistence for incomplete wizards.
|
||||
|
||||
** Contract
|
||||
|
||||
1. (on-key ch): dispatches key presses: Enter triggers send (extracts
|
||||
@@ -29,6 +85,23 @@ Event handlers + daemon I/O + main loop.
|
||||
4. (tui-main): the main loop — connects to daemon, initializes
|
||||
Croatoan windows, optionally starts Swank REPL, runs
|
||||
render/input event loop at ~30fps.
|
||||
5. (on-key-sidebar key): v0.8.0 — handles sidebar-specific
|
||||
keybindings: Ctrl+X+B toggles sidebar, Esc dismisses overlay.
|
||||
6. (on-key-palette key): v0.8.0 — handles command palette keypresses:
|
||||
Up/Down navigate items, Enter executes selection, Esc dismisses
|
||||
palette, printable characters append to filter string.
|
||||
7. (passepartout.channel-tui::palette-items): v0.8.0 — returns categorized command list as
|
||||
~((:category "Session" :items ((:name ... :desc ... :shortcut ... :action ...) ...)) ...)~.
|
||||
8. (palette-filter items query): v0.8.0 — returns items from the
|
||||
categorized list whose ~:name~ or ~:desc~ contains ~query~
|
||||
(case-insensitive substring match). Category headers preserved.
|
||||
9. (palette-execute selected-item): v0.8.0 — calls the selected
|
||||
item's ~:action~ function. Dismisses palette.
|
||||
10. (wizard-steps): v0.8.0 — returns ordered list of setup step
|
||||
definitions: ~(:title <str> :prompt <str> :validate <fn> :next <fn>)~.
|
||||
11. (wizard-next): v0.8.0 — runs current step's ~:validate~ on
|
||||
input buffer. On pass, increments ~:wizard-step~ and clears
|
||||
input. On fail, sets ~:wizard-error~. Returns new step index.
|
||||
|
||||
** Event Handlers
|
||||
#+begin_src lisp
|
||||
@@ -40,12 +113,81 @@ Event handlers + daemon I/O + main loop.
|
||||
;; so the cond below can use eq.
|
||||
(let* ((raw (car args))
|
||||
(ch (if (and (integerp raw) (> raw 255))
|
||||
(let* ((k (code-key raw))
|
||||
(name (and k (key-name k))))
|
||||
(or name raw))
|
||||
(or (let* ((k (code-key raw))
|
||||
(name (and k (key-name k))))
|
||||
name)
|
||||
;; Fallback for known ncurses codes when Croatoan
|
||||
;; key tables aren't available (e.g. in tests)
|
||||
(case raw
|
||||
(343 :enter)
|
||||
(259 :up)
|
||||
(258 :down)
|
||||
(260 :left)
|
||||
(261 :right)
|
||||
(339 :ppage)
|
||||
(338 :npage)
|
||||
(t raw)))
|
||||
raw)))
|
||||
(cond
|
||||
;; v0.7.1: Esc — interrupt streaming
|
||||
(cond
|
||||
;; v0.8.0: palette mode — handle palette keypresses first
|
||||
((and (st :palette-visible) (or (eql ch 27) (eq ch :escape)))
|
||||
(setf (st :palette-visible) nil)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((and (st :palette-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
|
||||
(let* ((filtered (palette-filter (st :palette-items) (st :palette-filter)))
|
||||
(idx (st :palette-selected-idx))
|
||||
(n 0)
|
||||
(item nil))
|
||||
(loop for group in filtered
|
||||
for gitems = (getf group :items)
|
||||
when (and (< n (length gitems)) (<= n idx (+ n (length gitems) -1)))
|
||||
do (setf item (nth (- idx n) gitems))
|
||||
(loop-finish)
|
||||
do (incf n (length gitems)))
|
||||
(passepartout.channel-tui::palette-execute item)
|
||||
(setf (st :palette-visible) nil)
|
||||
(setf (st :dirty) (list t t t))))
|
||||
((and (st :palette-visible) (eq ch :up))
|
||||
(setf (st :palette-selected-idx) (max 0 (1- (st :palette-selected-idx))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
((and (st :palette-visible) (eq ch :down))
|
||||
(setf (st :palette-selected-idx) (min 999 (1+ (st :palette-selected-idx))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
((and (st :palette-visible) (integerp ch) (>= ch 32) (<= ch 126))
|
||||
(let ((c (code-char ch)))
|
||||
(setf (st :palette-filter) (concatenate 'string (or (st :palette-filter) "") (string c)))
|
||||
(setf (st :palette-selected-idx) 0)
|
||||
(setf (st :dirty) (list nil t nil))))
|
||||
((and (st :palette-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
|
||||
(let ((f (st :palette-filter)))
|
||||
(when (and f (> (length f) 0))
|
||||
(setf (st :palette-filter) (subseq f 0 (1- (length f))))
|
||||
(setf (st :palette-selected-idx) 0)
|
||||
(setf (st :dirty) (list nil t nil)))))
|
||||
;; v0.8.0: setup wizard — handle wizard keypresses
|
||||
((and (st :wizard-visible) (or (eql ch 27) (eq ch :escape)))
|
||||
(wizard-cancel))
|
||||
((and (st :wizard-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
|
||||
(wizard-next))
|
||||
((and (st :wizard-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
|
||||
(let ((input (or (st :wizard-input) "")))
|
||||
(when (> (length input) 0)
|
||||
(setf (st :wizard-input) (subseq input 0 (1- (length input))))
|
||||
(setf (st :wizard-error) nil)
|
||||
(setf (st :dirty) (list nil t nil)))))
|
||||
((and (st :wizard-visible) (eql ch 2)) ; Ctrl+B — back
|
||||
(let ((step-idx (st :wizard-step)))
|
||||
(when (> step-idx 0)
|
||||
(setf (st :wizard-step) (1- step-idx)
|
||||
(st :wizard-input) ""
|
||||
(st :wizard-error) nil)
|
||||
(setf (st :dirty) (list nil t nil)))))
|
||||
((and (st :wizard-visible) (integerp ch) (>= ch 32) (<= ch 126))
|
||||
(let ((c (code-char ch)))
|
||||
(setf (st :wizard-input) (concatenate 'string (or (st :wizard-input) "") (string c)))
|
||||
(setf (st :wizard-error) nil)
|
||||
(setf (st :dirty) (list nil t nil))))
|
||||
;; v0.7.1: Esc — interrupt streaming
|
||||
((and (eql ch 27) (st :streaming-text))
|
||||
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
|
||||
(when (> (length (st :messages)) 0)
|
||||
@@ -139,8 +281,44 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (st :cursor-pos) 0))
|
||||
((eql ch 5) ; Ctrl+E — end
|
||||
(setf (st :cursor-pos) (length (st :input-buffer))))
|
||||
((eql ch 12) ; Ctrl+L — redraw
|
||||
(setf (st :dirty) (list t t t)))
|
||||
((eql ch 12) ; Ctrl+L — redraw
|
||||
(setf (st :dirty) (list t t t)))
|
||||
((eql ch 4) ; Ctrl+D — quit on empty
|
||||
(when (or (null (st :input-buffer)) (string= "" (input-string)))
|
||||
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
|
||||
((eql ch 6) ; v0.7.2 Ctrl+F — message search
|
||||
(add-msg :system "Use /search <query> to find messages"))
|
||||
((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard
|
||||
(wizard-start)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
|
||||
(let ((gate-idx nil))
|
||||
(loop for i from (1- (length (st :messages))) downto 0
|
||||
for m = (aref (st :messages) i)
|
||||
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
|
||||
do (setf gate-idx i) (loop-finish))
|
||||
(if gate-idx
|
||||
(let ((cg (st :collapsed-gates)))
|
||||
(if (member gate-idx cg)
|
||||
(setf (st :collapsed-gates) (remove gate-idx cg))
|
||||
(push gate-idx (st :collapsed-gates)))
|
||||
(add-msg :system (format nil "Gate trace ~a for msg ~a"
|
||||
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
|
||||
gate-idx))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
(add-msg :system "No gate trace to toggle"))))
|
||||
((eql ch 24) ; Ctrl+X prefix
|
||||
(setf (st :pending-ctrl-x) t))
|
||||
((and (st :pending-ctrl-x) (eql ch 2)) ; Ctrl+X+B — toggle sidebar
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
(passepartout.channel-tui::sidebar-toggle)
|
||||
(add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden")))
|
||||
((eql ch 16) ; Ctrl+P — command palette
|
||||
(setf (st :palette-visible) t
|
||||
(st :palette-filter) ""
|
||||
(st :palette-selected-idx) 0
|
||||
(st :palette-items) (passepartout.channel-tui::palette-items))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((eql ch 4) ; Ctrl+D — quit on empty
|
||||
(when (or (null (st :input-buffer)) (string= "" (input-string)))
|
||||
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
|
||||
@@ -251,80 +429,49 @@ Event handlers + daemon I/O + main loop.
|
||||
(subseq (or (getf info :hash) "(none)") 0 16)))
|
||||
(add-msg :system (format nil "Node ~a not found" node-id))))
|
||||
(add-msg :system "Memory audit not available")))
|
||||
;; /tags command — tag stack with trigger counts
|
||||
;; /tags command — tag stack
|
||||
;; /tags command — tag stack
|
||||
((string-equal text "/tags")
|
||||
(let ((cats passepartout::*tag-categories*)
|
||||
(counts passepartout::*tag-trigger-count*))
|
||||
(let ((cats passepartout::*tag-categories*))
|
||||
(if cats
|
||||
(dolist (entry cats)
|
||||
(let* ((tag (car entry))
|
||||
(sev (cdr entry))
|
||||
(n (gethash (string-downcase tag) counts 0)))
|
||||
(add-msg :system (format nil "~a: ~a (~d trigger~:p this session)" tag sev n))))
|
||||
(add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
|
||||
(add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
|
||||
;; /context command — section breakdown with token estimates
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4)))
|
||||
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
|
||||
;; /context command — context visibility
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4)))
|
||||
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
|
||||
(floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4)
|
||||
50))
|
||||
(log-tokens (min 4000 (floor (* msg-count 60) 4)))
|
||||
;; rough estimate: TIME, CONTEXT overhead
|
||||
(overhead-tokens 200)
|
||||
(total-est (+ id-tokens tool-tokens log-tokens overhead-tokens))
|
||||
(total-limit 8192)
|
||||
(pct-used (floor (* 100 total-est) total-limit))
|
||||
(bar (make-string (min 10 (max 1 (floor (/ (min total-est total-limit) total-limit) 10)))
|
||||
:initial-element #\#)))
|
||||
(add-msg :system (format nil "╔══ Context Budget ~a/~a tokens (~d%) ══╗" total-est total-limit pct-used))
|
||||
(add-msg :system (format nil "IDENTITY ~5d tokens" id-tokens))
|
||||
(add-msg :system (format nil "TOOLS ~5d tokens" tool-tokens))
|
||||
(add-msg :system (format nil "TIME+CONFIG ~5d tokens" overhead-tokens))
|
||||
(add-msg :system (format nil "LOGS ~5d tokens (~d msgs)" log-tokens msg-count))
|
||||
(add-msg :system (format nil " [~a~a] ~d%"
|
||||
bar (make-string (- 10 (length bar)) :initial-element #\Space) pct-used))
|
||||
(when (> pct-used 80)
|
||||
(add-msg :system "⚠ Context near limit — older messages may be dropped"))))
|
||||
;; /context why <id> — debug node with full attributes
|
||||
(log-tokens (min 4000 (floor (* msg-count 60) 4)))
|
||||
(overhead-tokens 200)
|
||||
(total-est (+ id-tokens tool-tokens log-tokens overhead-tokens))
|
||||
(total-limit 8192)
|
||||
(pct-used (floor (* 100 total-est) total-limit)))
|
||||
(add-msg :system (format nil "Context: ~d msgs, focus=~a, ~d/~d tokens (~d%)"
|
||||
msg-count focus total-est total-limit pct-used))
|
||||
(add-msg :system (format nil "IDENTITY ~5d tokens" id-tokens))
|
||||
(add-msg :system (format nil "LOGS ~5d tokens" log-tokens))
|
||||
(add-msg :system (format nil "TOOLS ~5d tokens" tool-tokens))
|
||||
(add-msg :system (format nil "TIME+CONFIG ~5d tokens" overhead-tokens))))
|
||||
;; /context why <id> — debug node
|
||||
((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why "))
|
||||
(let ((node-id (string-trim '(#\Space) (subseq text 13))))
|
||||
(if (fboundp 'passepartout::memory-object-get)
|
||||
(let ((obj (funcall 'passepartout::memory-object-get node-id)))
|
||||
(if obj
|
||||
(let ((attrs (passepartout::memory-object-attributes obj))
|
||||
(parent (passepartout::memory-object-parent-id obj))
|
||||
(children (passepartout::memory-object-children obj))
|
||||
(hash (or (passepartout::memory-object-hash obj) "(none)")))
|
||||
(add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a"
|
||||
node-id
|
||||
(passepartout::memory-object-type obj)
|
||||
(passepartout::memory-object-scope obj)
|
||||
(passepartout::memory-object-version obj)))
|
||||
(when parent
|
||||
(add-msg :system (format nil " parent: ~a" parent)))
|
||||
(when children
|
||||
(add-msg :system (format nil " children: ~d" (length children))))
|
||||
(add-msg :system (format nil " hash: ~a" (subseq hash 0 (min 32 (length hash)))))
|
||||
(when attrs
|
||||
(add-msg :system (format nil " title: ~a" (or (getf attrs :TITLE) "(none)")))))
|
||||
(add-msg :system (format nil "Node ~a not found in memory" node-id))))
|
||||
(add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a"
|
||||
node-id
|
||||
(passepartout::memory-object-type obj)
|
||||
(passepartout::memory-object-scope obj)
|
||||
(passepartout::memory-object-version obj)))
|
||||
(add-msg :system (format nil "Node ~a not found" node-id))))
|
||||
(add-msg :system "Memory not available"))))
|
||||
;; /context dropped — estimate pruned nodes from budget
|
||||
;; /context dropped — pruned nodes
|
||||
((string-equal text "/context dropped")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(est-total (* msg-count 60))
|
||||
(budget 8192)
|
||||
(dropped-msgs (if (> est-total budget)
|
||||
(floor (- est-total budget) 60)
|
||||
0)))
|
||||
(if (> dropped-msgs 0)
|
||||
(add-msg :system (format nil "Estimate: ~d messages (~d tokens) may be pruned at budget ~d tokens (~d% used)"
|
||||
dropped-msgs (- est-total budget) budget
|
||||
(floor (* 100 est-total) budget)))
|
||||
(add-msg :system (format nil "Within budget: ~d tokens used of ~d tokens (~d%)"
|
||||
est-total budget (floor (* 100 est-total) budget))))))
|
||||
(add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
|
||||
;; /search command — message search
|
||||
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
|
||||
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
|
||||
@@ -377,16 +524,16 @@ Event handlers + daemon I/O + main loop.
|
||||
(add-msg :system "No snapshots available"))))
|
||||
;; /audit verify — memory integrity
|
||||
((string-equal text "/audit verify")
|
||||
(if (fboundp 'passepartout::audit-verify-hash)
|
||||
(let* ((result (funcall 'passepartout::audit-verify-hash))
|
||||
(total (car result))
|
||||
(missing (cdr result)))
|
||||
(add-msg :system (format nil "Audit: ~d objects, ~d missing hashes, ~d snapshots~@[ — VERIFY PASS~]~@[ — ~d MISSING HASHES~]"
|
||||
total missing
|
||||
(length passepartout::*memory-snapshots*)
|
||||
(zerop missing)
|
||||
(unless (zerop missing) missing))))
|
||||
(add-msg :system "Memory audit not available")))
|
||||
(let ((count 0) (hashed 0))
|
||||
(maphash (lambda (k v) (declare (ignore k))
|
||||
(when v
|
||||
(incf count)
|
||||
(when (passepartout::memory-object-hash v)
|
||||
(incf hashed))))
|
||||
passepartout::*memory-store*)
|
||||
(add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots"
|
||||
count hashed
|
||||
(length passepartout::*memory-snapshots*)))))
|
||||
;; /resume <n> — resume from snapshot
|
||||
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume "))
|
||||
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
|
||||
@@ -399,28 +546,23 @@ Event handlers + daemon I/O + main loop.
|
||||
(add-msg :system "Usage: /resume <number>"))))
|
||||
;; /help <topic> — search user manual
|
||||
((and (>= (length text) 6) (string-equal (subseq text 0 6) "/help "))
|
||||
(let ((topic (string-trim '(#\Space) (subseq text 6)))
|
||||
(sections (self-help-lookup (string-trim '(#\Space) (subseq text 6)))))
|
||||
(if sections
|
||||
(dolist (entry sections)
|
||||
(let* ((title (car entry))
|
||||
(content (cdr entry))
|
||||
(preview (if (> (length content) 300)
|
||||
(concatenate 'string (subseq content 0 297) "...")
|
||||
content)))
|
||||
(add-msg :system (format nil "~a: ~a" title preview))))
|
||||
(add-msg :system (format nil "No manual section found for '~a'" topic)))))
|
||||
((string-equal text "/help")
|
||||
(add-msg :system "/eval <expr> Evaluate Lisp")
|
||||
(add-msg :system "/undo Undo last operation")
|
||||
(add-msg :system "/redo Redo last operation")
|
||||
(add-msg :system "/why Show last gate trace")
|
||||
(add-msg :system "/identity Edit IDENTITY.org")
|
||||
(add-msg :system "/tags List tag severities")
|
||||
(add-msg :system "/audit <id> Inspect memory object")
|
||||
(add-msg :system "/search <q> Search messages")
|
||||
(add-msg :system "/context Show context summary")
|
||||
(add-msg :system "/rewind <n> Rewind to snapshot N")
|
||||
(let* ((topic (string-trim '(#\Space) (subseq text 6)))
|
||||
(results (self-help-lookup topic)))
|
||||
(dolist (entry results)
|
||||
(add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
|
||||
(unless results
|
||||
(add-msg :system (format nil "Topic '~a' not found in USER_MANUAL.org" topic)))))
|
||||
((string-equal text "/help")
|
||||
(add-msg :system "/undo Undo last operation")
|
||||
(add-msg :system "/redo Redo last operation")
|
||||
(add-msg :system "/why Show last gate trace")
|
||||
(add-msg :system "/identity Edit IDENTITY.org")
|
||||
(add-msg :system "/tags List tag severities")
|
||||
(add-msg :system "/audit <id> Inspect memory object")
|
||||
(add-msg :system "/search <q> Search messages")
|
||||
(add-msg :system "/context Show context summary")
|
||||
(add-msg :system "/eval <expr> Evaluate Lisp")
|
||||
(add-msg :system "/rewind <n> Rewind to snapshot N")
|
||||
(add-msg :system "/sessions Show snapshots")
|
||||
(add-msg :system "/resume <n> Resume from snapshot")
|
||||
(add-msg :system "/focus <proj> Set project context")
|
||||
@@ -428,7 +570,12 @@ Event handlers + daemon I/O + main loop.
|
||||
(add-msg :system "/help [topic] Show this help")
|
||||
(add-msg :system "\\ + Enter Multi-line input")
|
||||
(add-msg :system "Ctrl+G Toggle gate trace"))
|
||||
;; /theme command
|
||||
;; /setup command — open wizard
|
||||
((string-equal text "/setup")
|
||||
(wizard-start)
|
||||
(add-msg :system "Setup wizard opened (Ctrl+W)")
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
;; /theme command
|
||||
((string-equal text "/theme")
|
||||
(add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
|
||||
*tui-theme-current-name*
|
||||
@@ -596,14 +743,15 @@ Event handlers + daemon I/O + main loop.
|
||||
(reverse (coerce (nth (st :input-hpos) h) 'list))
|
||||
nil))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; PageUp — scroll back by page (10 lines)
|
||||
;; PageUp
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
|
||||
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
|
||||
(let ((page-size (max 10 (floor (length (st :messages)) 3))))
|
||||
(setf (st :scroll-offset) (+ (st :scroll-offset) page-size)))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
;; PageDown — scroll forward by page
|
||||
;; PageDown
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
|
||||
(let ((page-size (max 10 (floor (length (st :messages)) 3))))
|
||||
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) page-size))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
;; Printable
|
||||
(t
|
||||
@@ -615,6 +763,235 @@ Event handlers + daemon I/O + main loop.
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
|
||||
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
|
||||
(defun palette-items ()
|
||||
"Returns categorized command list for the palette."
|
||||
(let ((items nil))
|
||||
(push (list :category "Session" :items
|
||||
(list (list :name "/focus" :desc "Set project context" :shortcut "C-o"
|
||||
:action (lambda () (add-msg :system "/focus <project>")))
|
||||
(list :name "/scope" :desc "Change context scope"
|
||||
:action (lambda () (add-msg :system "/scope memex|session|project")))
|
||||
(list :name "/unfocus" :desc "Pop context stack"
|
||||
:action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
|
||||
(list :name "/search" :desc "Search messages" :shortcut "C-f"
|
||||
:action (lambda () (add-msg :system "Use /search <query> to find messages")))))
|
||||
items)
|
||||
(push (list :category "Agent" :items
|
||||
(list (list :name "/why" :desc "Show last gate trace" :shortcut "C-g"
|
||||
:action (lambda () (add-msg :system "Gate trace: use /why")))
|
||||
(list :name "/audit" :desc "Inspect memory object"
|
||||
:action (lambda () (add-msg :system "/audit <node-id>")))
|
||||
(list :name "/context" :desc "Show context budget"
|
||||
:action (lambda () (add-msg :system "/context")))))
|
||||
items)
|
||||
(push (list :category "View" :items
|
||||
(list (list :name "/theme" :desc "Switch color theme"
|
||||
:action (lambda () (add-msg :system "Presets: dark light solarized gruvbox nord tokyonight catppuccin monokai")))
|
||||
(list :name "/sidebar" :desc "Toggle sidebar" :shortcut "C-x C-b"
|
||||
:action #'sidebar-toggle)
|
||||
(list :name "/help" :desc "Show all commands"
|
||||
:action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar")))))
|
||||
items)
|
||||
(push (list :category "System" :items
|
||||
(list (list :name "/setup" :desc "Run setup wizard" :shortcut "C-\\"
|
||||
:action (lambda () (wizard-start)
|
||||
(add-msg :system "Setup wizard opened")
|
||||
(setf (st :dirty) (list t t nil))))
|
||||
(list :name "/eval" :desc "Evaluate Lisp expression"
|
||||
:action (lambda () (add-msg :system "/eval <expr>")))
|
||||
(list :name "/reconnect" :desc "Reconnect to daemon"
|
||||
:action (lambda () (disconnect-daemon) (connect-daemon)))
|
||||
(list :name "/quit" :desc "Save history and exit" :shortcut "C-d"
|
||||
:action (lambda () (add-msg :system "* Goodbye *")
|
||||
(send-daemon (list :type :event :payload '(:action :quit)))
|
||||
(setf (st :running) nil)))))
|
||||
items)
|
||||
(nreverse items)))
|
||||
|
||||
(defun palette-execute (selected-item)
|
||||
"Execute the selected palette item's action."
|
||||
(when (and selected-item (getf selected-item :action))
|
||||
(funcall (getf selected-item :action))))
|
||||
|
||||
(defun wizard-steps ()
|
||||
"Returns the ordered list of setup wizard steps."
|
||||
(list
|
||||
(list :title "Provider Selection"
|
||||
:prompt "LLM provider (openai, anthropic, ollama, openrouter, deepseek, groq):"
|
||||
:validate (lambda (input)
|
||||
(let ((provider (string-downcase (string-trim '(#\Space) input))))
|
||||
(if (member provider '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq")
|
||||
:test #'string=)
|
||||
(progn (setf (st :wizard-provider) provider) nil)
|
||||
(format nil "Unknown provider: ~a" input)))))
|
||||
(list :title "API Key"
|
||||
:prompt (format nil "API key for ~a:" (or (st :wizard-provider) "provider"))
|
||||
:validate (lambda (input)
|
||||
(let ((key (string-trim '(#\Space) input)))
|
||||
(if (> (length key) 4)
|
||||
(progn (setf (st :wizard-api-key) key) nil)
|
||||
"Key too short — enter a valid API key"))))
|
||||
(list :title "Memory"
|
||||
:prompt "Max memory entries? (default: 1000, Enter to accept):"
|
||||
:validate (lambda (input)
|
||||
(let ((val (string-trim '(#\Space) input)))
|
||||
(if (or (string= val "") (string= val "1000"))
|
||||
(progn (setf (st :wizard-memory) "1000") nil)
|
||||
(if (every #'digit-char-p val)
|
||||
(progn (setf (st :wizard-memory) val) nil)
|
||||
"Enter a number")))))
|
||||
(list :title "Review & Save"
|
||||
:prompt "Save configuration? (yes/no):"
|
||||
:validate (lambda (input)
|
||||
(let ((val (string-downcase (string-trim '(#\Space) input))))
|
||||
(cond
|
||||
((string= val "yes")
|
||||
(wizard-write-config)
|
||||
nil)
|
||||
((string= val "no")
|
||||
(setf (st :wizard-visible) nil
|
||||
(st :wizard-step) 0
|
||||
(st :wizard-error) nil)
|
||||
(add-msg :system "Wizard cancelled — run /setup to restart")
|
||||
nil)
|
||||
(t "Type 'yes' to save or 'no' to cancel")))))))
|
||||
|
||||
(defun wizard-start ()
|
||||
"Open the setup wizard at step 0."
|
||||
(setf (st :wizard-visible) t
|
||||
(st :wizard-step) 0
|
||||
(st :wizard-input) ""
|
||||
(st :wizard-error) nil
|
||||
(st :wizard-provider) nil
|
||||
(st :wizard-api-key) nil
|
||||
(st :wizard-memory) nil))
|
||||
|
||||
(defun wizard-next ()
|
||||
"Validate current step input; advance on success, show error on failure."
|
||||
(let ((steps (wizard-steps))
|
||||
(step-idx (st :wizard-step)))
|
||||
(when (< step-idx (length steps))
|
||||
(let* ((step (nth step-idx steps))
|
||||
(validate-fn (getf step :validate))
|
||||
(error-msg (funcall validate-fn (or (st :wizard-input) ""))))
|
||||
(if error-msg
|
||||
(setf (st :wizard-error) error-msg
|
||||
(st :dirty) (list nil t nil))
|
||||
(if (= step-idx (1- (length steps)))
|
||||
(progn
|
||||
(setf (st :wizard-visible) nil
|
||||
(st :wizard-step) 0
|
||||
(st :wizard-error) nil)
|
||||
(add-msg :system "Configuration saved. Run /reconnect to reload."))
|
||||
(setf (st :wizard-step) (1+ step-idx)
|
||||
(st :wizard-input) ""
|
||||
(st :wizard-error) nil
|
||||
(st :dirty) (list nil t nil))))))))
|
||||
|
||||
(defun wizard-cancel ()
|
||||
"Dismiss the wizard, preserving state for resumption."
|
||||
(setf (st :wizard-visible) nil
|
||||
(st :dirty) (list t t nil)))
|
||||
|
||||
(defun wizard-write-config ()
|
||||
"Write collected wizard data to .env and notify."
|
||||
(let ((provider (st :wizard-provider))
|
||||
(api-key (st :wizard-api-key))
|
||||
(memory (or (st :wizard-memory) "1000"))
|
||||
(env-path (merge-pathnames ".env" (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(handler-case
|
||||
(progn
|
||||
(uiop:ensure-all-directories-exist (list env-path))
|
||||
(with-open-file (out env-path :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(format out "# Passepartout configuration (generated by setup wizard)~%")
|
||||
(format out "PROVIDER_CASCADE=~a~%" provider)
|
||||
(format out "~:@(~a~)_API_KEY=~a~%" provider api-key)
|
||||
(format out "MEMORY_MAX_ENTRIES=~a~%" memory)
|
||||
(format out "DAEMON_PORT=9105~%")))
|
||||
(error (c)
|
||||
(setf (st :wizard-error) (format nil "Failed to write config: ~a" c)))))
|
||||
(setf (st :wizard-visible) nil
|
||||
(st :wizard-step) 0
|
||||
(st :wizard-error) nil)
|
||||
(add-msg :system (format nil "Configuration saved to memex/.env (~a). Run /reconnect to reload." provider)))
|
||||
|
||||
(defun resolve-hitl-panel (decision)
|
||||
"Mark the most recent HITL panel message as resolved with DECISION."
|
||||
(loop for i from (1- (length (st :messages))) downto 0
|
||||
for m = (aref (st :messages) i)
|
||||
when (and (getf m :panel) (not (getf m :panel-resolved)))
|
||||
do (setf (getf m :panel-resolved) decision)
|
||||
(setf (aref (st :messages) i) m)
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(loop-finish)))
|
||||
|
||||
(defun on-daemon-msg (msg)
|
||||
(let* ((payload (getf msg :payload))
|
||||
(text (getf payload :text))
|
||||
(msg-type (getf msg :type))
|
||||
(action (getf payload :action))
|
||||
(level (getf msg :level))
|
||||
(sensor (getf payload :sensor))
|
||||
(gate-trace (getf msg :gate-trace))
|
||||
(rule-count (getf payload :rule-count))
|
||||
(foveal-id (getf payload :foveal-id)))
|
||||
;; v0.7.2: HITL approval-required panel
|
||||
(when (eq level :approval-required)
|
||||
(let* ((hitl-msg (or (getf payload :message)
|
||||
(getf payload :text)
|
||||
"HITL approval required"))
|
||||
(hitl-action (getf (getf payload :action) :payload))
|
||||
(tool-name (getf hitl-action :tool))
|
||||
(explanation (or tool-name "unknown action")))
|
||||
(add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
|
||||
hitl-msg explanation)
|
||||
:panel t))
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(return-from on-daemon-msg nil))
|
||||
;; v0.7.1: streaming chunk
|
||||
(when (eq msg-type :stream-chunk)
|
||||
(cond
|
||||
((string= text "")
|
||||
;; Final chunk: stamp time, clear streaming
|
||||
(when (> (length (st :messages)) 0)
|
||||
(let ((idx (1- (length (st :messages)))))
|
||||
(setf (getf (aref (st :messages) idx) :streaming) nil)
|
||||
(setf (getf (aref (st :messages) idx) :time) (now))))
|
||||
(setf (st :streaming-text) nil)
|
||||
(setf (st :busy) nil)
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(return-from on-daemon-msg nil))
|
||||
((null (st :streaming-text))
|
||||
;; First chunk: add new streaming message
|
||||
(setf (st :streaming-text) "")
|
||||
(setf (st :busy) nil)
|
||||
(add-msg :agent text)
|
||||
(let ((idx (1- (length (st :messages)))))
|
||||
(setf (getf (aref (st :messages) idx) :streaming) t))
|
||||
(setf (st :streaming-text) text)
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(return-from on-daemon-msg nil))
|
||||
(t
|
||||
;; Subsequent chunk: append
|
||||
(let* ((new-text (concatenate 'string (st :streaming-text) text))
|
||||
(idx (1- (length (st :messages)))))
|
||||
(setf (st :streaming-text) new-text)
|
||||
(setf (getf (aref (st :messages) idx) :content) new-text)
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
(return-from on-daemon-msg nil))))
|
||||
(when rule-count (setf (st :rule-count) rule-count))
|
||||
(when foveal-id (setf (st :foveal-id) foveal-id))
|
||||
(cond
|
||||
(text (setf (st :busy) nil)
|
||||
(add-msg :agent text :gate-trace gate-trace))
|
||||
((eq action :handshake)
|
||||
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
|
||||
(t (add-msg :agent (format nil "~a" msg))))))
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
|
||||
(defun resolve-hitl-panel (decision)
|
||||
"Mark the most recent HITL panel message as resolved with DECISION."
|
||||
@@ -721,8 +1098,13 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (getf (aref (st :messages) idx) :content) new-text)
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
(return-from on-daemon-msg nil))))
|
||||
(when rule-count (setf (st :rule-count) rule-count))
|
||||
(when foveal-id (setf (st :foveal-id) foveal-id))
|
||||
(when rule-count (setf (st :rule-count) rule-count))
|
||||
(when foveal-id (setf (st :foveal-id) foveal-id))
|
||||
;; v0.8.0: sidebar enrichment fields
|
||||
(when (getf payload :block-counts) (setf (st :block-counts) (getf payload :block-counts)))
|
||||
(when (getf payload :context-usage) (setf (st :context-usage) (getf payload :context-usage)))
|
||||
(when (getf payload :modified-files) (setf (st :modified-files) (getf payload :modified-files)))
|
||||
(when (getf payload :session-cost) (setf (st :session-cost) (getf payload :session-cost)))
|
||||
(cond
|
||||
(text (setf (st :busy) nil)
|
||||
(add-msg :agent text :gate-trace gate-trace))
|
||||
@@ -827,17 +1209,19 @@ Event handlers + daemon I/O + main loop.
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
|
||||
(sidebar-w (when (>= w 120)
|
||||
(make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44))))
|
||||
(content-w (if sidebar-w (- w 44) (- w 2)))
|
||||
(ch (- h 5))
|
||||
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
|
||||
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
|
||||
(swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(sw (make-instance 'window :height 3 :width content-w :y 0 :x 1))
|
||||
(cw (make-instance 'window :height ch :width content-w :y 3 :x 1))
|
||||
(iw (make-instance 'window :height 1 :width content-w :y (- h 1) :x 1))
|
||||
(swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
;; Store windows in state for SIGWINCH handler
|
||||
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(connect-daemon)
|
||||
(when (> swank-port 0)
|
||||
@@ -850,44 +1234,103 @@ Event handlers + daemon I/O + main loop.
|
||||
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
|
||||
(error ()
|
||||
(add-msg :system "* Swank unavailable *"))))
|
||||
;; Initial render before the main loop — otherwise the screen stays
|
||||
;; blank until the first keystroke (get-char blocks).
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(let ((ch (get-char iw)))
|
||||
(cond
|
||||
((or (not ch) (equal ch -1)) nil)
|
||||
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
|
||||
((eql ch 410)
|
||||
(let* ((new-h (or (height scr) 24))
|
||||
(new-w (or (width scr) 80))
|
||||
(new-ch (- new-h 5)))
|
||||
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
|
||||
ch new-ch
|
||||
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
|
||||
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
|
||||
w new-w
|
||||
h new-h)
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
(st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)))
|
||||
(t (on-key ch))))
|
||||
(flet ((recreate-windows (scr-width scr-height)
|
||||
(let* ((new-w scr-width)
|
||||
(new-h scr-height)
|
||||
(has-sidebar (and (>= new-w 120) (st :sidebar-visible)))
|
||||
(new-sidebar-w (when has-sidebar
|
||||
(make-instance 'window :height (- new-h 5)
|
||||
:width 42 :y 3 :x (- new-w 44))))
|
||||
(new-content-w (if new-sidebar-w (- new-w 44) (- new-w 2)))
|
||||
(new-ch (- new-h 5)))
|
||||
(setq sw (make-instance 'window :height 3 :width new-content-w :y 0 :x 1)
|
||||
ch new-ch
|
||||
cw (make-instance 'window :height new-ch :width new-content-w :y 3 :x 1)
|
||||
iw (make-instance 'window :height 1 :width new-content-w :y (- new-h 1) :x 1)
|
||||
sidebar-w new-sidebar-w
|
||||
w new-w
|
||||
h new-h)
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
(st :sw) sw (st :cw) cw (st :iw) iw))))
|
||||
(let ((initial-sidebar (and (>= w 120) (st :sidebar-visible))))
|
||||
(when initial-sidebar
|
||||
(view-sidebar (or sidebar-w
|
||||
(make-instance 'window :height (- h 5) :width 42
|
||||
:y 3 :x (- w 44))))
|
||||
(refresh (or sidebar-w
|
||||
(make-instance 'window :height (- h 5) :width 42
|
||||
:y 3 :x (- w 44))))))
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
(disconnect-daemon))))
|
||||
(when sidebar-w
|
||||
(view-sidebar sidebar-w)
|
||||
(refresh sidebar-w))
|
||||
(when (st :palette-visible)
|
||||
(let* ((pw (min 56 (floor (* w 0.7))))
|
||||
(ph (min 18 (floor (* h 0.6))))
|
||||
(px (floor (- w pw) 2))
|
||||
(py (floor (- h ph) 2))
|
||||
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
|
||||
(view-palette palette-win)
|
||||
(refresh palette-win)
|
||||
(close palette-win)))
|
||||
(when (st :wizard-visible)
|
||||
(let* ((ww 60) (wh 14)
|
||||
(wx (floor (- w ww) 2))
|
||||
(wy (floor (- h wh) 2))
|
||||
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
|
||||
(view-wizard wizard-win)
|
||||
(refresh wizard-win)
|
||||
(close wizard-win)))
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(let ((ch (get-char iw)))
|
||||
(cond
|
||||
((or (not ch) (equal ch -1)) nil)
|
||||
((eql ch 410)
|
||||
(recreate-windows (or (width scr) 80) (or (height scr) 24))
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr))
|
||||
(t (on-key ch))))
|
||||
(redraw sw cw ch iw)
|
||||
(when sidebar-w
|
||||
(view-sidebar sidebar-w)
|
||||
(refresh sidebar-w))
|
||||
;; Recreate windows when sidebar visibility or terminal width changes
|
||||
(let ((sidebar-wanted (and (st :sidebar-visible) (>= w 120))))
|
||||
(when (or (and sidebar-wanted (not sidebar-w))
|
||||
(and (not sidebar-wanted) sidebar-w))
|
||||
(recreate-windows w h)
|
||||
(redraw sw cw ch iw)))
|
||||
(when (st :palette-visible)
|
||||
(let* ((pw (min 56 (floor (* w 0.7))))
|
||||
(ph (min 18 (floor (* h 0.6))))
|
||||
(px (floor (- w pw) 2))
|
||||
(py (floor (- h ph) 2))
|
||||
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
|
||||
(view-palette palette-win)
|
||||
(refresh palette-win)
|
||||
(close palette-win)))
|
||||
(when (st :wizard-visible)
|
||||
(let* ((ww 60) (wh 14)
|
||||
(wx (floor (- w ww) 2))
|
||||
(wy (floor (- h wh) 2))
|
||||
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
|
||||
(view-wizard wizard-win)
|
||||
(refresh wizard-win)
|
||||
(close wizard-win)))
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
(disconnect-daemon)))))
|
||||
|
||||
#+end_src
|
||||
|
||||
@@ -1368,3 +1811,119 @@ Event handlers + daemon I/O + main loop.
|
||||
(on-key :npage)
|
||||
(fiveam:is (= 0 (st :scroll-offset))))
|
||||
#+end_src
|
||||
|
||||
* v0.8.0 Tests — Sidebar, Palette, Theme, Wizard
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout-tui-tests)
|
||||
|
||||
(fiveam:test test-theme-hex-to-rgb
|
||||
"Contract 4: theme-hex-to-rgb parses #RRGGBB to integer triple."
|
||||
(multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "#5E81AC")
|
||||
(fiveam:is (= 94 r))
|
||||
(fiveam:is (= 129 g))
|
||||
(fiveam:is (= 172 b))))
|
||||
|
||||
(fiveam:test test-theme-hex-to-rgb-invalid
|
||||
"Contract 4: theme-hex-to-rgb returns white for invalid input."
|
||||
(multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "not-a-color")
|
||||
(fiveam:is (= 255 r))
|
||||
(fiveam:is (= 255 g))
|
||||
(fiveam:is (= 255 b))))
|
||||
|
||||
(fiveam:test test-sidebar-toggle
|
||||
"Contract 7: sidebar-toggle flips :sidebar-visible and sets dirty flags."
|
||||
(init-state)
|
||||
(setf (st :dirty) (list nil nil nil))
|
||||
(passepartout.channel-tui::sidebar-toggle)
|
||||
(fiveam:is (eq t (st :sidebar-visible)))
|
||||
(fiveam:is (eq t (first (st :dirty))))
|
||||
(fiveam:is (eq t (second (st :dirty)))))
|
||||
|
||||
(fiveam:test test-ctrl-x-b-toggles-sidebar
|
||||
"Contract 5: Ctrl+X then Ctrl+B toggles sidebar."
|
||||
(init-state)
|
||||
(on-key 24) ; Ctrl+X
|
||||
(fiveam:is (eq t (st :pending-ctrl-x)))
|
||||
(on-key 2) ; Ctrl+B
|
||||
(fiveam:is (eq t (st :sidebar-visible))))
|
||||
|
||||
(fiveam:test test-ctrl-p-opens-palette
|
||||
"Contract 6: Ctrl+P opens command palette."
|
||||
(init-state)
|
||||
(on-key 16) ; Ctrl+P
|
||||
(fiveam:is (eq t (st :palette-visible)))
|
||||
(fiveam:is (not (null (st :palette-items))))
|
||||
(fiveam:is (= 0 (st :palette-selected-idx))))
|
||||
|
||||
(fiveam:test test-palette-escape-dismisses
|
||||
"Contract 6: Esc dismisses palette."
|
||||
(init-state)
|
||||
(setf (st :palette-visible) t)
|
||||
(on-key 27) ; Esc
|
||||
(fiveam:is (null (st :palette-visible))))
|
||||
|
||||
(fiveam:test test-palette-enter-executes
|
||||
"Contract 9: Enter executes selected item and dismisses palette."
|
||||
(init-state)
|
||||
(setf (st :palette-visible) t
|
||||
(st :palette-selected-idx) 0
|
||||
(st :palette-items) (passepartout.channel-tui::palette-items))
|
||||
(on-key (char-code #\/))
|
||||
(on-key (char-code #\t))
|
||||
(fiveam:is (string= "/t" (st :palette-filter))))
|
||||
|
||||
(fiveam:test test-palette-items-has-categories
|
||||
"Contract 7: palette-items returns categorized list with at least Session and View."
|
||||
(init-state)
|
||||
(let ((items (passepartout.channel-tui::palette-items)))
|
||||
(fiveam:is (listp items))
|
||||
(fiveam:is (find "Session" items :key (lambda (g) (getf g :category)) :test #'string=))
|
||||
(fiveam:is (find "View" items :key (lambda (g) (getf g :category)) :test #'string=))))
|
||||
|
||||
;; ── v0.8.0 Setup Wizard ──
|
||||
|
||||
(fiveam:test test-wizard-steps-count
|
||||
"Contract v0.8.0: wizard-steps returns 4 steps."
|
||||
(let ((steps (passepartout.channel-tui::wizard-steps)))
|
||||
(fiveam:is (= 4 (length steps)))))
|
||||
|
||||
(fiveam:test test-wizard-start-sets-visible
|
||||
"Contract v0.8.0: wizard-start sets wizard-visible and resets state."
|
||||
(init-state)
|
||||
(passepartout.channel-tui::wizard-start)
|
||||
(fiveam:is (eq t (st :wizard-visible)))
|
||||
(fiveam:is (= 0 (st :wizard-step)))
|
||||
(fiveam:is (string= "" (st :wizard-input))))
|
||||
|
||||
(fiveam:test test-wizard-cancel-hides
|
||||
"Contract v0.8.0: wizard-cancel hides the wizard."
|
||||
(init-state)
|
||||
(setf (st :wizard-visible) t)
|
||||
(passepartout.channel-tui::wizard-cancel)
|
||||
(fiveam:is (null (st :wizard-visible))))
|
||||
|
||||
(fiveam:test test-wizard-next-valid-advances
|
||||
"Contract v0.8.0: valid input advances to next step."
|
||||
(init-state)
|
||||
(passepartout.channel-tui::wizard-start)
|
||||
(setf (st :wizard-input) "openai")
|
||||
(passepartout.channel-tui::wizard-next)
|
||||
(fiveam:is (= 1 (st :wizard-step)))
|
||||
(fiveam:is (string= "openai" (st :wizard-provider))))
|
||||
|
||||
(fiveam:test test-wizard-next-invalid-shows-error
|
||||
"Contract v0.8.0: invalid input shows error and stays on current step."
|
||||
(init-state)
|
||||
(passepartout.channel-tui::wizard-start)
|
||||
(setf (st :wizard-input) "invalid-provider")
|
||||
(passepartout.channel-tui::wizard-next)
|
||||
(fiveam:is (= 0 (st :wizard-step)))
|
||||
(fiveam:is (not (null (st :wizard-error)))))
|
||||
|
||||
(fiveam:test test-ctrl-backslash-opens-wizard
|
||||
"Contract v0.8.0: Ctrl+\\ opens the setup wizard."
|
||||
(init-state)
|
||||
(on-key 28) ; Ctrl+\
|
||||
(fiveam:is (eq t (st :wizard-visible))))
|
||||
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user