docs: port TUI roadmap to cl-tty, mark Emacs as secondary client
v0.8.0: Information Radiator now built on cl-tty v1.1.0. Minibuffer uses cl-tty Dialog stack. New TODO items: conversation view (ScrollBox + Markdown), command palette (Select), sidebar (slot system), status bar (Box + Theme), keybindings (keymap). v0.9.1: Emacs is now an optional secondary client, not the primary bridge. cl-tty is the primary TUI.
This commit is contained in:
@@ -5,74 +5,38 @@
|
||||
|
||||
Event handlers + daemon I/O + main loop.
|
||||
|
||||
** v0.8.0 — Sidebar Controller
|
||||
** v0.8.0 — Minibuffer (cl-tty Dialog Stack)
|
||||
|
||||
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.
|
||||
Replaces ad-hoc palette + wizard overlays with cl-tty's Dialog stack.
|
||||
Typing =/= as the first character opens a ~select-dialog~ with ~25 slash
|
||||
commands filtered in real time. Selecting a command dispatches it;
|
||||
selecting =/wizard= transitions to a ~prompt-dialog~ chain. cl-tty's
|
||||
~cl-tty.dialog:*dialog-stack*~ handles push/pop; Esc dismisses the top dialog.
|
||||
|
||||
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.
|
||||
~*slash-commands*~ is the single source of truth for available commands.
|
||||
~open-minibuffer~ pushes the select-dialog. ~minibuffer-handle-key~
|
||||
converts Croatoan key codes to cl-tty ~key-event~ structs and delegates
|
||||
to ~select-handle-key~. Printable characters update the Select's filter;
|
||||
Backspace removes the last filter character; Enter/Up/Down/Esc route
|
||||
through the select widget's navigation.
|
||||
|
||||
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.
|
||||
The wizard-dialog subclass validates each step and writes config to
|
||||
~/.passepartout/config.lisp~. Daisy-chaining: wizard provider selection
|
||||
→ API key entry → save confirmation. Future sub-modes (=/settings=,
|
||||
=/help=) slot in as additional dialog types pushed onto the same stack.
|
||||
|
||||
** Contract
|
||||
|
||||
1. (on-key ch): dispatches key presses: Enter triggers send (extracts
|
||||
input buffer, pushes history, sends to daemon, clears buffer),
|
||||
~\\ + Enter~ inserts a literal newline (multi-line input),
|
||||
~/help~ lists all commands, ~/eval <expr>~ evaluates a Lisp
|
||||
expression, ~/focus <proj>~ switches project context,
|
||||
~/scope <scope>~ changes context scope, ~/unfocus~ pops context,
|
||||
Tab completes command names, Backspace deletes, arrows scroll
|
||||
chat and history.
|
||||
v0.7.0: Ctrl+U clears line, Ctrl+W deletes word, Ctrl+A/E home/end,
|
||||
Ctrl+L redraws, Ctrl+D quit on empty, Ctrl+X+E opens $EDITOR.
|
||||
v0.8.0: when a dialog is on cl-tty's ~cl-tty.dialog:*dialog-stack*~, keys route
|
||||
through ~minibuffer-handle-key~ instead of normal input. Typing =/=
|
||||
as the first character opens a ~select-dialog~ with ~*slash-commands*~.
|
||||
Non-printable keys are ignored.
|
||||
2. (on-daemon-msg msg): processes inbound daemon messages. Routes
|
||||
text responses to chat display (:agent), handshake to system
|
||||
@@ -84,24 +48,31 @@ if the user reopens it within the same session. State is per-session only
|
||||
over the framed TCP protocol.
|
||||
4. (tui-main): the main loop — connects to daemon, initializes
|
||||
Croatoan windows, optionally starts Swank REPL, runs
|
||||
render/input event loop at ~30fps.
|
||||
render/input event loop at ~30fps. Renders dialog overlays when
|
||||
cl-tty's ~cl-tty.dialog:*dialog-stack*~ is non-nil.
|
||||
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.
|
||||
6. (*slash-commands*): v0.8.0 — list of ~25 command plists, each
|
||||
with ~:name~ (display string), ~:desc~ (tooltip), and ~:action~
|
||||
(thunk that dispatches the command). Drives cl-tty's ~Select~ widget.
|
||||
7. (open-minibuffer): v0.8.0 — pushes a ~select-dialog~ onto cl-tty's
|
||||
~cl-tty.dialog:*dialog-stack*~ with ~*slash-commands*~ as options. Sets the
|
||||
select's ~:on-select~ to dispatch the chosen command.
|
||||
8. (minibuffer-handle-key ch): v0.8.0 — converts Croatoan key code CH
|
||||
to a cl-tty ~key-event~, then routes through the active dialog's
|
||||
~select-handle-key~. Returns T if handled (dialog consumed the key).
|
||||
9. (make-wizard-dialog): v0.8.0 — creates a multi-step wizard dialog:
|
||||
provider selection → API key entry → save confirmation. Returns a
|
||||
~dialog~ instance pushed onto ~cl-tty.dialog:*dialog-stack*~. Each step validates
|
||||
before advancing. Final step writes ~/.passepartout/config.lisp~.
|
||||
10. (*daemon-commands*): v0.8.0 — list of ~16 daemon command plists,
|
||||
organized by category (Session, Memory, System, Help), each with
|
||||
~:title~, ~:value~, ~:desc~, ~:action~, and optional ~:category t~
|
||||
for headers. Drives the command palette (~ctrl-tty Select~).
|
||||
11. (open-command-palette): v0.8.0 — pushes a ~select-dialog~ onto
|
||||
~cl-tty.dialog:*dialog-stack*~ with ~*daemon-commands*~ as options.
|
||||
Categories are rendered as dimmed headers; selection dispatches the
|
||||
command's ~:action~ thunk. Opens on Ctrl+P.
|
||||
|
||||
** Event Handlers
|
||||
#+begin_src lisp
|
||||
@@ -128,66 +99,13 @@ if the user reopens it within the same session. State is per-session only
|
||||
(338 :npage)
|
||||
(t raw)))
|
||||
raw)))
|
||||
(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
|
||||
(cond
|
||||
;; v0.8.0: minibuffer dialog active — route through cl-tty select
|
||||
((and (boundp 'cl-tty.dialog:*dialog-stack*)
|
||||
cl-tty.dialog:*dialog-stack*
|
||||
(minibuffer-handle-key ch))
|
||||
(setf (st :dirty) (list t 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)
|
||||
@@ -288,10 +206,15 @@ if the user reopens it within the same session. State is per-session only
|
||||
(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)
|
||||
((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer
|
||||
(open-minibuffer)
|
||||
;; If minibuffer opens, simulate typing /setup to filter to it
|
||||
(when cl-tty.dialog:*dialog-stack*
|
||||
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
|
||||
(when (typep sel 'select)
|
||||
(setf (cl-tty.select:select-filter sel) "setup"))))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
|
||||
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate collapse
|
||||
(let ((gate-idx nil))
|
||||
(loop for i from (1- (length (st :messages))) downto 0
|
||||
for m = (aref (st :messages) i)
|
||||
@@ -313,35 +236,33 @@ if the user reopens it within the same session. State is per-session only
|
||||
(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.")))
|
||||
((eql ch 6) ; v0.7.2 Ctrl+F — message search
|
||||
(add-msg :system "Use /search <query> to find messages"))
|
||||
((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))
|
||||
((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands)
|
||||
(progn
|
||||
(open-command-palette)
|
||||
(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.")))
|
||||
((eql ch 6) ; v0.7.2 Ctrl+F — message search
|
||||
(add-msg :system "Use /search <query> to find messages"))
|
||||
((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 5)) ; Ctrl+X+E — editor
|
||||
(setf (st :pending-ctrl-x) nil)
|
||||
(add-msg :system "Opening $EDITOR... save and exit to return.")
|
||||
@@ -570,11 +491,14 @@ if the user reopens it within the same session. State is per-session only
|
||||
(add-msg :system "/help [topic] Show this help")
|
||||
(add-msg :system "\\ + Enter Multi-line input")
|
||||
(add-msg :system "Ctrl+G Toggle gate trace"))
|
||||
;; /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)))
|
||||
;; /setup command — open minibuffer filtered to setup
|
||||
((string-equal text "/setup")
|
||||
(open-minibuffer)
|
||||
(when cl-tty.dialog:*dialog-stack*
|
||||
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
|
||||
(when (typep sel 'select)
|
||||
(setf (cl-tty.select:select-filter sel) "setup"))))
|
||||
(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"
|
||||
@@ -754,167 +678,270 @@ if the user reopens it within the same session. State is per-session only
|
||||
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) page-size))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
;; Printable
|
||||
(t
|
||||
(let ((chr (typecase ch
|
||||
(character ch)
|
||||
(integer (code-char ch))
|
||||
(t nil))))
|
||||
(when (and chr (graphic-char-p chr))
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
(t
|
||||
(let ((chr (typecase ch
|
||||
(character ch)
|
||||
(integer (code-char ch))
|
||||
(t nil))))
|
||||
(when (and chr (graphic-char-p chr))
|
||||
(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))))
|
||||
;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog
|
||||
|
||||
(defun wizard-steps ()
|
||||
"Returns the ordered list of setup wizard steps."
|
||||
(defvar *slash-commands*
|
||||
(list (list :name "/focus" :desc "Set project context"
|
||||
:action (lambda () (add-msg :system "/focus")))
|
||||
(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"
|
||||
:action (lambda () (add-msg :system "Use /search <query>")))
|
||||
(list :name "/why" :desc "Show last gate trace"
|
||||
: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")))
|
||||
(list :name "/theme" :desc "Switch color theme"
|
||||
:action (lambda () (add-msg :system "Presets: dark light solarized gruvbox")))
|
||||
(list :name "/sidebar" :desc "Toggle sidebar"
|
||||
:action #'sidebar-toggle)
|
||||
(list :name "/help" :desc "Show all commands"
|
||||
:action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
|
||||
(list :name "/setup" :desc "Run setup wizard"
|
||||
:action (lambda () (make-wizard-dialog)))
|
||||
(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"
|
||||
:action (lambda () (add-msg :system "* Goodbye *")
|
||||
(send-daemon (list :type :event :payload '(:action :quit)))
|
||||
(setf (st :running) nil))))
|
||||
"~25 slash commands driving cl-tty's Select widget in the minibuffer.")
|
||||
|
||||
(defun open-minibuffer ()
|
||||
"Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack."
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:select-dialog
|
||||
"Commands"
|
||||
(loop for cmd in *slash-commands*
|
||||
collect (list :title (getf cmd :name)
|
||||
:value cmd
|
||||
:desc (getf cmd :desc)))
|
||||
:on-select (lambda (opt)
|
||||
(let ((cmd (getf opt :value))
|
||||
(action (when cmd (getf cmd :action))))
|
||||
(when action (funcall action)))))))
|
||||
|
||||
(defvar *daemon-commands*
|
||||
(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")))))))
|
||||
;; Category: Session
|
||||
(list :title "── Session ──" :category t)
|
||||
(list :title "Focus Project" :value :focus :desc "Set project context"
|
||||
:action (lambda () (add-msg :system "Usage: /focus <project>")))
|
||||
(list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project"
|
||||
:action (lambda () (add-msg :system "Usage: /scope memex|session|project")))
|
||||
(list :title "Unfocus" :value :unfocus :desc "Pop context stack"
|
||||
:action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
|
||||
(list :title "Show Context" :value :context :desc "Show context budget summary"
|
||||
:action (lambda () (add-msg :system "Use /context for budget or /context why <id> for node details")))
|
||||
;; Category: Memory
|
||||
(list :title "── Memory ──" :category t)
|
||||
(list :title "List Sessions" :value :sessions :desc "List memory snapshots"
|
||||
:action (lambda () (add-msg :system "Use /sessions to list snapshots")))
|
||||
(list :title "Rewind" :value :rewind :desc "Rewind to snapshot"
|
||||
:action (lambda () (add-msg :system "Usage: /rewind <number>")))
|
||||
(list :title "Audit Node" :value :audit :desc "Inspect memory object"
|
||||
:action (lambda () (add-msg :system "Usage: /audit <node-id>")))
|
||||
;; Category: System
|
||||
(list :title "── System ──" :category t)
|
||||
(list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon"
|
||||
:action (lambda () (disconnect-daemon) (connect-daemon)))
|
||||
(list :title "Quit" :value :quit :desc "Save history and exit"
|
||||
:action (lambda () (add-msg :system "* Goodbye *")
|
||||
(send-daemon (list :type :event :payload '(:action :quit)))
|
||||
(setf (st :running) nil)))
|
||||
;; Category: Help
|
||||
(list :title "── Help ──" :category t)
|
||||
(list :title "Show Help" :value :help :desc "Show all commands"
|
||||
:action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
|
||||
(list :title "Why" :value :why :desc "Show last gate trace"
|
||||
:action (lambda () (add-msg :system "Use /why to see last gate trace")))
|
||||
(list :title "Identity" :value :identity :desc "Edit IDENTITY.org"
|
||||
:action (lambda () (add-msg :system "Use /identity to edit")))
|
||||
(list :title "Tags" :value :tags :desc "List tag severities"
|
||||
:action (lambda () (add-msg :system "Use /tags to list tag severities"))))
|
||||
"Daemon commands for the command palette (Ctrl+P), organized by category.")
|
||||
|
||||
(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 open-command-palette ()
|
||||
"Push a select-dialog with *daemon-commands* onto cl-tty's dialog stack.
|
||||
Ctrl+P opens this palette. Categories: Session, Memory, System, Help."
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:select-dialog
|
||||
"Command Palette"
|
||||
(loop for cmd in *daemon-commands*
|
||||
collect (list :title (getf cmd :title)
|
||||
:value cmd
|
||||
:desc (getf cmd :desc)
|
||||
:category (getf cmd :category)))
|
||||
:on-select (lambda (opt)
|
||||
(let ((cmd (getf opt :value))
|
||||
(action (when cmd (getf cmd :action))))
|
||||
(when action (funcall action)))))))
|
||||
|
||||
(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 croatoan-to-tty-event (ch)
|
||||
"Convert a Croatoan key code to a cl-tty key-event struct."
|
||||
(typecase ch
|
||||
(keyword
|
||||
(case ch
|
||||
(:up (cl-tty.input:make-key-event :key :up))
|
||||
(:down (cl-tty.input:make-key-event :key :down))
|
||||
(:enter (cl-tty.input:make-key-event :key :enter))
|
||||
(:escape (cl-tty.input:make-key-event :key :escape))
|
||||
(:backspace (cl-tty.input:make-key-event :key :backspace))
|
||||
(:ppage (cl-tty.input:make-key-event :key :page-up))
|
||||
(:npage (cl-tty.input:make-key-event :key :page-down))
|
||||
(t (cl-tty.input:make-key-event :key ch))))
|
||||
(integer
|
||||
(cond
|
||||
((= ch 27) (cl-tty.input:make-key-event :key :escape))
|
||||
((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter))
|
||||
((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace))
|
||||
((= ch 259) (cl-tty.input:make-key-event :key :up))
|
||||
((= ch 258) (cl-tty.input:make-key-event :key :down))
|
||||
((= ch 260) (cl-tty.input:make-key-event :key :left))
|
||||
((= ch 261) (cl-tty.input:make-key-event :key :right))
|
||||
((= ch 339) (cl-tty.input:make-key-event :key :page-up))
|
||||
((= ch 338) (cl-tty.input:make-key-event :key :page-down))
|
||||
((<= 1 ch 26) (cl-tty.input:make-key-event
|
||||
:key (intern (string (code-char (+ #x60 ch))) :keyword)
|
||||
:ctrl t))
|
||||
((<= 32 ch 126) (cl-tty.input:make-key-event
|
||||
:key (intern (string (char-upcase (code-char ch))) :keyword)))
|
||||
(t (cl-tty.input:make-key-event :key :unknown :code ch))))
|
||||
(t nil)))
|
||||
|
||||
(defun wizard-cancel ()
|
||||
"Dismiss the wizard, preserving state for resumption."
|
||||
(setf (st :wizard-visible) nil
|
||||
(st :dirty) (list t t nil)))
|
||||
(defun minibuffer-handle-key (ch)
|
||||
"Route Croatoan key through the active dialog's select widget.
|
||||
Printable chars update the filter; special keys route through cl-tty.select:select-handle-key.
|
||||
Returns T if the dialog consumed the key."
|
||||
(let ((stack cl-tty.dialog:*dialog-stack*))
|
||||
(unless stack (return-from minibuffer-handle-key nil))
|
||||
(let* ((dialog (first stack))
|
||||
(content (cl-tty.dialog:dialog-content dialog)))
|
||||
(unless (typep content 'cl-tty.select:select)
|
||||
(return-from minibuffer-handle-key nil))
|
||||
;; Backspace: pop last filter char (if any) or pop dialog when empty
|
||||
(when (or (eql ch :backspace) (eql ch 263) (eql ch 127) (eql ch 8))
|
||||
(let ((f (cl-tty.select:select-filter content)))
|
||||
(if (and f (> (length f) 0))
|
||||
(progn (setf (cl-tty.select:select-filter content) (subseq f 0 (1- (length f))))
|
||||
(cl-tty.select::select-clamp-index content)
|
||||
t)
|
||||
(progn (cl-tty.dialog:pop-dialog) t))))
|
||||
;; Escape: pop the dialog
|
||||
(when (or (eql ch 27) (eq ch :escape))
|
||||
(cl-tty.dialog:pop-dialog)
|
||||
t)
|
||||
;; Printable: append to filter if dialog is a select
|
||||
(when (and (integerp ch) (<= 32 ch 126))
|
||||
(let* ((c (code-char ch))
|
||||
(f (or (cl-tty.select:select-filter content) "")))
|
||||
(setf (cl-tty.select:select-filter content)
|
||||
(concatenate 'string f (string c)))
|
||||
(cl-tty.select::select-clamp-index content)
|
||||
t))
|
||||
;; Route through cl-tty.select:select-handle-key for navigation/selection
|
||||
(let ((ev (croatoan-to-tty-event ch)))
|
||||
(when ev
|
||||
(handler-case
|
||||
(cl-tty.select:select-handle-key content ev)
|
||||
(error () 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 make-wizard-dialog ()
|
||||
"Create a setup wizard dialog daisy-chain: provider select → API key → save.
|
||||
Validates at each step; final step writes ~/.passepartout/config.lisp."
|
||||
(let* ((state (list :provider nil :api-key nil :memory "1000" :step 0))
|
||||
(step-labels '("Provider" "API Key" "Memory" "Review & Save"))
|
||||
(step-fns
|
||||
(list
|
||||
;; Step 0: provider selection
|
||||
(lambda (input)
|
||||
(let ((p (string-downcase (string-trim '(#\Space) input))))
|
||||
(if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=)
|
||||
(progn (setf (getf state :provider) p) nil)
|
||||
(format nil "Unknown provider: ~a" input))))
|
||||
;; Step 1: API key
|
||||
(lambda (input)
|
||||
(let ((k (string-trim '(#\Space) input)))
|
||||
(if (> (length k) 4)
|
||||
(progn (setf (getf state :api-key) k) nil)
|
||||
"Key too short")))
|
||||
;; Step 2: memory limit
|
||||
(lambda (input)
|
||||
(let ((v (string-trim '(#\Space) input)))
|
||||
(if (or (string= v "") (string= v "1000"))
|
||||
nil
|
||||
(if (every #'digit-char-p v)
|
||||
(progn (setf (getf state :memory) v) nil)
|
||||
"Enter a number"))))
|
||||
;; Step 3: save
|
||||
(lambda (input)
|
||||
(let ((v (string-downcase (string-trim '(#\Space) input))))
|
||||
(cond ((string= v "yes")
|
||||
(let ((env-path (merge-pathnames ".passepartout/config.lisp"
|
||||
(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~%")
|
||||
(format out "(setf *provider* ~s)~%" (getf state :provider))
|
||||
(format out "(setf *api-key* ~s)~%" (getf state :api-key))
|
||||
(format out "(setf *memory-max-entries* ~s)~%" (getf state :memory))))
|
||||
(error (c) (format nil "Write failed: ~a" c))))
|
||||
nil)
|
||||
((string= v "no") nil)
|
||||
(t "Type 'yes' or 'no'")))))))
|
||||
(labels ((advance ()
|
||||
(let* ((step (getf state :step))
|
||||
(fn (nth step step-fns))
|
||||
(err (funcall fn "ignored")))
|
||||
(declare (ignore fn))
|
||||
;; Push next prompt dialog or finish
|
||||
(if (< step (1- (length step-labels)))
|
||||
(progn
|
||||
(setf (getf state :step) (1+ step))
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:prompt-dialog
|
||||
(format nil "~a — ~a" (nth (getf state :step) step-labels)
|
||||
(getf state :provider))
|
||||
:on-submit (lambda (val)
|
||||
(let ((validation (funcall (nth (getf state :step) step-fns) val)))
|
||||
(if validation
|
||||
(progn
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:alert-dialog "Error" validation))
|
||||
(setf (getf state :step) (1- step)))
|
||||
(advance)))))))
|
||||
(add-msg :system (format nil "Configuration saved (~a). Run /reconnect."
|
||||
(getf state :provider)))))))
|
||||
;; Push the first prompt dialog
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:prompt-dialog
|
||||
"Setup — LLM Provider"
|
||||
:on-submit (lambda (val)
|
||||
(let ((err (funcall (first step-fns) val)))
|
||||
(if err
|
||||
(cl-tty.dialog:push-dialog
|
||||
(cl-tty.dialog:alert-dialog "Invalid" err))
|
||||
(advance)))))))))
|
||||
|
||||
(defun resolve-hitl-panel (decision)
|
||||
"Mark the most recent HITL panel message as resolved with DECISION."
|
||||
@@ -1263,23 +1290,10 @@ if the user reopens it within the same session. State is per-session only
|
||||
(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)))
|
||||
;; v0.8.0: render cl-tty dialog overlay when stack is non-empty
|
||||
(when (and (boundp 'cl-tty.dialog:*dialog-stack*)
|
||||
cl-tty.dialog:*dialog-stack*)
|
||||
(render-dialog-overlay scr w h))
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
@@ -1308,27 +1322,70 @@ if the user reopens it within the same session. State is per-session only
|
||||
(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)))
|
||||
;; v0.8.0: render cl-tty dialog overlay
|
||||
(when (and (boundp 'cl-tty.dialog:*dialog-stack*)
|
||||
cl-tty.dialog:*dialog-stack*)
|
||||
(render-dialog-overlay scr w h))
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
(disconnect-daemon))))
|
||||
|
||||
(defun render-dialog-overlay (scr w h)
|
||||
"Render the top cl-tty dialog as a Croatoan overlay.
|
||||
Draws a dimmed backdrop then a centered bordered panel with select options."
|
||||
(let* ((dialog (first cl-tty.dialog:*dialog-stack*))
|
||||
(title (cl-tty.dialog:dialog-title dialog))
|
||||
(content (cl-tty.dialog:dialog-content dialog))
|
||||
(ww (min 60 (- w 4)))
|
||||
(wh (min 18 (- h 4)))
|
||||
(wx (floor (- w ww) 2))
|
||||
(wy (floor (- h wh) 2)))
|
||||
;; Dimmed backdrop
|
||||
(dotimes (row h)
|
||||
(add-string scr (make-string w :initial-element #\Space)
|
||||
:y row :x 0 :fgcolor (theme-color :dim) :bgcolor (theme-color :background)))
|
||||
;; Dialog panel window
|
||||
(let ((win (make-instance 'window :height wh :width ww :y wy :x wx)))
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
|
||||
(box win 0 0)
|
||||
(add-string win (format nil " ~a " title) :y 0 :x 2 :fgcolor (theme-color :accent))
|
||||
;; Render select widget options
|
||||
(when (typep content 'cl-tty.select:select)
|
||||
(let* ((filtered (cl-tty.select:select-filtered-options content))
|
||||
(sel-idx (cl-tty.select:select-selected-index content))
|
||||
(filter-str (cl-tty.select:select-filter content))
|
||||
(y 1))
|
||||
;; Show filter line
|
||||
(add-string win (format nil " > ~a_" (or filter-str ""))
|
||||
:y y :x 2 :n (- ww 4) :fgcolor (theme-color :input))
|
||||
(incf y)
|
||||
;; Show filtered options
|
||||
(dolist (item filtered)
|
||||
(when (< y (1- wh))
|
||||
(let* ((display-idx (first item))
|
||||
(option (third item))
|
||||
(title-str (getf option :title))
|
||||
(desc (getf option :desc))
|
||||
(is-selected (= display-idx sel-idx))
|
||||
(fg (if is-selected (theme-color :highlight) (theme-color :agent))))
|
||||
(when is-selected
|
||||
(setf (color-pair win) (list (theme-color :highlight) (theme-color :dim)))
|
||||
(add-string win (make-string (- ww 2) :initial-element #\Space)
|
||||
:y y :x 1 :n (- ww 2))
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background))))
|
||||
(add-string win (format nil "~a ~a" (if is-selected ">" " ") title-str)
|
||||
:y y :x 2 :n (min 25 (- ww 4)) :fgcolor fg)
|
||||
(when (and desc (not is-selected))
|
||||
(add-string win (format nil " ~a" desc) :y y :x 28 :n (- ww 30)
|
||||
:fgcolor (theme-color :dim)))
|
||||
(incf y))))
|
||||
;; Footer hint
|
||||
(add-string win (format nil " ~a/~a | ↑↓ Navigate Enter Execute Esc Close"
|
||||
(1+ sel-idx) (length filtered))
|
||||
:y (1- wh) :x 1 :n (- ww 2) :fgcolor (theme-color :dim))))
|
||||
(refresh win)
|
||||
(close win))))
|
||||
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
@@ -1851,83 +1908,72 @@ if the user reopens it within the same session. State is per-session only
|
||||
(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."
|
||||
(fiveam:test test-ctrl-p-opens-command-palette
|
||||
"Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)."
|
||||
(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:is-true (and cl-tty.dialog:*dialog-stack*)))
|
||||
|
||||
(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-open-minibuffer-pushes-dialog
|
||||
"Contract 7: open-minibuffer pushes a dialog with a select content."
|
||||
(let ((cl-tty.dialog:*dialog-stack* nil))
|
||||
(passepartout.channel-tui::open-minibuffer)
|
||||
(fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
|
||||
(let ((item (first cl-tty.dialog:*dialog-stack*)))
|
||||
(fiveam:is (string= "DIALOG" (symbol-name (class-name (class-of item)))))
|
||||
(let ((content (cl-tty.dialog:dialog-content item)))
|
||||
(fiveam:is (not (null content)))))))
|
||||
|
||||
(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-slash-commands-count
|
||||
"Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action."
|
||||
(let ((cmds passepartout.channel-tui::*slash-commands*))
|
||||
(fiveam:is (>= (length cmds) 14))
|
||||
(dolist (c cmds)
|
||||
(fiveam:is (stringp (getf c :name)))
|
||||
(fiveam:is (stringp (getf c :desc)))
|
||||
(fiveam:is (functionp (getf c :action))))))
|
||||
|
||||
(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=))))
|
||||
(fiveam:test test-daemon-commands-count
|
||||
"Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers."
|
||||
(let ((cmds passepartout.channel-tui::*daemon-commands*))
|
||||
(fiveam:is (>= (length cmds) 14))
|
||||
(dolist (c cmds)
|
||||
(if (getf c :category)
|
||||
(fiveam:is (stringp (getf c :title)))
|
||||
(progn
|
||||
(fiveam:is (stringp (getf c :title)))
|
||||
(fiveam:is (stringp (getf c :desc)))
|
||||
(fiveam:is (functionp (getf c :action))))))))
|
||||
|
||||
;; ── v0.8.0 Setup Wizard ──
|
||||
(fiveam:test test-minibuffer-handle-key-escape
|
||||
"Contract 8: minibuffer-handle-key with Esc pops dialog."
|
||||
(let ((cl-tty.dialog:*dialog-stack* nil))
|
||||
(passepartout.channel-tui::open-minibuffer)
|
||||
(fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
|
||||
(passepartout.channel-tui::minibuffer-handle-key 27) ; Esc
|
||||
(fiveam:is (null cl-tty.dialog:*dialog-stack*))))
|
||||
|
||||
(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-minibuffer-handle-key-backspace
|
||||
"Contract 8: Backspace pops filter char, then pops dialog on empty."
|
||||
(let ((cl-tty.dialog:*dialog-stack* nil))
|
||||
(passepartout.channel-tui::open-minibuffer)
|
||||
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
|
||||
(setf (cl-tty.select:select-filter sel) "te")
|
||||
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
|
||||
(fiveam:is (string= "t" (cl-tty.select:select-filter sel)))
|
||||
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
|
||||
(fiveam:is (string= "" (or (cl-tty.select:select-filter sel) ""))))))
|
||||
|
||||
(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))))
|
||||
(fiveam:test test-croatoan-to-tty-event-arrows
|
||||
"Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events."
|
||||
(let ((up (passepartout.channel-tui::croatoan-to-tty-event 259)))
|
||||
(fiveam:is (cl-tty.input:key-event-p up))
|
||||
(fiveam:is (eql :up (cl-tty.input:key-event-key up))))
|
||||
(let ((down (passepartout.channel-tui::croatoan-to-tty-event 258)))
|
||||
(fiveam:is (eql :down (cl-tty.input:key-event-key down))))
|
||||
(let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13)))
|
||||
(fiveam:is (eql :enter (cl-tty.input:key-event-key enter))))
|
||||
(let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27)))
|
||||
(fiveam:is (eql :escape (cl-tty.input:key-event-key esc)))))
|
||||
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user