fix: close defun on-key with missing paren, complete cl-tty TUI migration

- Added missing closing paren for defun on-key in org/channel-tui-main.org
  line 616 (was 7 trailing ), now 8)
- Replaced #\) character literal with (code-char 41) to avoid reader
  ambiguity with paren-delimiter counting
- All 3 TUI org files tangled and verified compilable
- passepartout/tui loads without errors under SBCL 2.5.2
This commit is contained in:
Hermes
2026-05-12 21:35:14 +00:00
parent d77d41f3a8
commit 757541c83b
9 changed files with 658 additions and 286 deletions

View File

@@ -3,8 +3,8 @@
* View
Pure render functions. Each takes a Croatoan window and current state.
State is read via ~(st :key)~ — no mutation here.
|Pure render functions. Each takes the cl-tty backend and current state.
|State is read via ~(st :key)~ — no mutation here.
** Contract
@@ -42,31 +42,29 @@ architecture:
All three enrichments cost 0 LLM tokens — they are daemon-state queries
that the TUI actuator attaches to the response plist before transmission.
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(defun view-status (fb w)
(let ((line1 (format nil
" Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
(if (st :busy) " …thinking" "")))))
(cl-tty.backend:draw-text fb 1 1 line1
(theme-color (if (st :connected) :connected :disconnected))
nil)
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) nil)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) nil)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -85,11 +83,8 @@ that the TUI actuator attaches to the response plist before transmission.
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
@@ -101,7 +96,7 @@ that the TUI actuator attaches to the response plist before transmission.
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
@@ -110,14 +105,14 @@ that the TUI actuator attaches to the response plist before transmission.
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
@@ -148,48 +143,40 @@ that the TUI actuator attaches to the response plist before transmission.
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y)))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (passepartout::gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
#+end_src
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
#+END_SRC
** Input Line
#+begin_src lisp
(defun view-input (win)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-input (fb w)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
#+end_src
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (sw cw ch iw)
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
#+end_src
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
#+END_SRC
* Implementation — v0.7.0 additions
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun char-width (ch)
@@ -213,10 +200,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))
#+end_src
#+END_SRC
* v0.7.1 — Markdown Rendering
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun parse-markdown-spans (text)
@@ -257,21 +244,20 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(defun render-styled (fb segments y x w)
"Render markdown segments to cl-tty backend. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bold bold :underline underline
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(declare (ignore code))
(cl-tty.backend:draw-text fb x y text
(cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent))))
nil
:bold bold)
(incf x (length text))))
y)
@@ -336,10 +322,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
:keyword :function))) r)
(setf p fe)))))))))
(nreverse r)))
#+end_src
#+END_SRC
* v0.7.2 — Gate Trace
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun gate-trace-lines (trace)
@@ -366,10 +352,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(if (eq result :approval) " (HITL required)" ""))))
(push (cons text (list :fgcolor color)) lines)))
(nreverse lines)))
#+end_src
#+END_SRC
* Test Suite
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
@@ -477,4 +463,4 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))
#+end_src
#+END_SRC