v0.8.3: TUI stabilization — box calls, package fixes, sandbox, configure
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
This commit is contained in:
@@ -218,7 +218,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(search-highlight content (st :search-query))
|
||||
content))
|
||||
(line-text (format nil "~a [~a] ~a" prefix time content-show))
|
||||
(wrapped (passepartout::word-wrap line-text (- w 2)))
|
||||
(wrapped (word-wrap line-text (- w 2)))
|
||||
(nlines (length wrapped)))
|
||||
(if (<= nlines lines-remaining)
|
||||
(progn (decf lines-remaining nlines) (incf msg-count))
|
||||
@@ -240,7 +240,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(search-highlight content (st :search-query))
|
||||
content))
|
||||
(line-text (format nil "~a [~a] ~a" prefix time content-show))
|
||||
(wrapped (passepartout::word-wrap line-text (- w 2))))
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
;; HITL panel: render with colored border
|
||||
(when is-panel
|
||||
(setf color (if is-resolved
|
||||
@@ -257,7 +257,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
;; 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))
|
||||
(dolist (entry (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))))))))))
|
||||
@@ -304,43 +304,43 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
|
||||
(test test-char-width-ascii
|
||||
"Contract 5: ASCII characters (< 128) have width 1."
|
||||
(is (= 1 (passepartout::char-width #\a)))
|
||||
(is (= 1 (passepartout::char-width #\Space)))
|
||||
(is (= 1 (passepartout::char-width #\@))))
|
||||
(is (= 1 (char-width #\a)))
|
||||
(is (= 1 (char-width #\Space)))
|
||||
(is (= 1 (char-width #\@))))
|
||||
|
||||
(test test-char-width-tab
|
||||
"Contract 5: tab character has width 8."
|
||||
(is (= 8 (passepartout::char-width #\Tab))))
|
||||
(is (= 8 (char-width #\Tab))))
|
||||
|
||||
(test test-char-width-cjk
|
||||
"Contract 5: CJK characters have width 2."
|
||||
(is (= 2 (passepartout::char-width #\日))))
|
||||
(is (= 2 (char-width #\日))))
|
||||
|
||||
(test test-char-width-null
|
||||
"Contract 5: null has width 0."
|
||||
(is (= 0 (passepartout::char-width #\Nul))))
|
||||
(is (= 0 (char-width #\Nul))))
|
||||
|
||||
(test test-markdown-bold
|
||||
"Contract 7: parse-markdown-spans detects **bold**."
|
||||
(let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
|
||||
(let ((segments (parse-markdown-spans "hello **world**!")))
|
||||
(is (= 3 (length segments)))))
|
||||
|
||||
(test test-markdown-plain
|
||||
"Contract 7: plain text returns single segment."
|
||||
(let ((segments (passepartout::parse-markdown-spans "plain")))
|
||||
(let ((segments (parse-markdown-spans "plain")))
|
||||
(is (= 1 (length segments)))
|
||||
(is (string= "plain" (caar segments)))))
|
||||
|
||||
(test test-markdown-url
|
||||
"Contract 7: parse-markdown-spans detects URLs."
|
||||
(let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
|
||||
(let ((segments (parse-markdown-spans "see https://example.com for more")))
|
||||
(is (>= (length segments) 2))
|
||||
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
|
||||
|
||||
(test test-markdown-blocks
|
||||
"Contract 8: parse-markdown-blocks detects code blocks."
|
||||
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
|
||||
(segs (passepartout::parse-markdown-blocks text)))
|
||||
(segs (parse-markdown-blocks text)))
|
||||
(is (= 3 (length segs)))
|
||||
(let ((code (second segs)))
|
||||
(is (eq t (getf code :code-block)))
|
||||
@@ -350,44 +350,44 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(test test-markdown-blocks-no-close
|
||||
"Contract 8: unclosed code block returns content."
|
||||
(let* ((text (format nil "```~%unclosed code"))
|
||||
(segs (passepartout::parse-markdown-blocks text)))
|
||||
(segs (parse-markdown-blocks text)))
|
||||
(is (= 1 (length segs)))
|
||||
(is (eq t (getf (first segs) :code-block)))))
|
||||
|
||||
(test test-syntax-highlight
|
||||
"Contract 9: syntax-highlight colors Lisp code."
|
||||
(let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
|
||||
(let ((segs (syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
|
||||
(is (>= (length segs) 3))))
|
||||
|
||||
(test test-syntax-highlight-keyword
|
||||
"Contract 9: syntax-highlight colors keywords."
|
||||
(let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
|
||||
(let ((segs (syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
|
||||
(is (>= (length segs) 2))
|
||||
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
|
||||
|
||||
(test test-syntax-highlight-function
|
||||
"Contract 9: syntax-highlight colors function calls."
|
||||
(let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
|
||||
(let ((segs (syntax-highlight "(+ 1 2)" "lisp")))
|
||||
(is (>= (length segs) 2))
|
||||
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
|
||||
|
||||
(test test-gate-trace-lines-passed
|
||||
"Contract 9: gate-trace-lines for passed gate."
|
||||
(let ((lines (passepartout::gate-trace-lines
|
||||
(let ((lines (gate-trace-lines
|
||||
'((:gate "path" :result :passed)))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
|
||||
|
||||
(test test-gate-trace-lines-blocked
|
||||
"Contract 9: gate-trace-lines for blocked gate."
|
||||
(let ((lines (passepartout::gate-trace-lines
|
||||
(let ((lines (gate-trace-lines
|
||||
'((:gate "shell" :result :blocked :reason "rm")))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (search "rm" (caar lines)))))
|
||||
|
||||
(test test-gate-trace-lines-approval
|
||||
"Contract 9: gate-trace-lines for approval gate."
|
||||
(let ((lines (passepartout::gate-trace-lines
|
||||
(let ((lines (gate-trace-lines
|
||||
'((:gate "network" :result :approval)))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (search "HITL" (caar lines)))))
|
||||
@@ -401,7 +401,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
|
||||
* Implementation — v0.7.0 additions
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
@@ -456,7 +456,7 @@ Respects CJK/emoji char widths via char-width."
|
||||
|
||||
* v0.7.1 — Markdown Rendering
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun parse-markdown-spans (text)
|
||||
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
|
||||
@@ -505,12 +505,17 @@ Respects CJK/emoji char widths via char-width."
|
||||
(bold (getf attrs :bold))
|
||||
(code (getf attrs :code))
|
||||
(underline (getf attrs :underline))
|
||||
(url (getf attrs :url)))
|
||||
(url (getf attrs :url))
|
||||
(style-bits (append (when bold '(:bold))
|
||||
(when underline '(:underline)))))
|
||||
(when style-bits
|
||||
(add-attributes win (get-bitmask style-bits)))
|
||||
(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)))))
|
||||
:bgcolor (when code (theme-color :dim))
|
||||
:fgcolor (cond (url (theme-color :highlight))
|
||||
(t (theme-color (or (getf attrs :role) :agent)))))
|
||||
(when style-bits
|
||||
(remove-attributes win (get-bitmask style-bits)))
|
||||
(incf x (length text))))
|
||||
y)
|
||||
|
||||
@@ -579,7 +584,7 @@ Respects CJK/emoji char widths via char-width."
|
||||
|
||||
* v0.7.2 — Gate Trace
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun gate-trace-lines (trace)
|
||||
"Convert gate-trace plist to display lines."
|
||||
@@ -590,10 +595,10 @@ Respects CJK/emoji char widths via char-width."
|
||||
(reason (getf entry :reason))
|
||||
(name (or gate "unknown"))
|
||||
(color (case result
|
||||
(:passed :gate-passed)
|
||||
(:blocked :gate-blocked)
|
||||
(:approval :gate-approval)
|
||||
(t :dim)))
|
||||
(:passed (theme-color :gate-passed))
|
||||
(:blocked (theme-color :gate-blocked))
|
||||
(:approval (theme-color :gate-approval))
|
||||
(t (theme-color :dim))))
|
||||
(prefix (case result
|
||||
(:passed " ✓ ")
|
||||
(:blocked " ✗ ")
|
||||
@@ -614,7 +619,8 @@ Respects CJK/emoji char widths via char-width."
|
||||
(defun view-sidebar (win)
|
||||
"Render 42-column sidebar with 7 panels: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
|
||||
(clear win)
|
||||
(box win (theme-color :border) (theme-color :background))
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
|
||||
(box win 0 0)
|
||||
(let* ((w (or (width win) 42))
|
||||
(h (or (height win) 24))
|
||||
(y 1)
|
||||
@@ -629,7 +635,7 @@ Respects CJK/emoji char widths via char-width."
|
||||
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
|
||||
(incf y)
|
||||
(if gate-trace
|
||||
(dolist (entry (passepartout::gate-trace-lines gate-trace))
|
||||
(dolist (entry (gate-trace-lines gate-trace))
|
||||
(when (< y (1- h))
|
||||
(add-string win (car entry) :y y :x 2 :n (- w 4)
|
||||
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
|
||||
@@ -723,7 +729,8 @@ Respects CJK/emoji char widths via char-width."
|
||||
(defun view-palette (win)
|
||||
"Render centered command palette overlay with filtered items, selection highlight."
|
||||
(clear win)
|
||||
(box win (theme-color :border) (theme-color :background))
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
|
||||
(box win 0 0)
|
||||
(let* ((w (or (width win) 50))
|
||||
(h (or (height win) 20))
|
||||
(y 1)
|
||||
@@ -766,7 +773,8 @@ Respects CJK/emoji char widths via char-width."
|
||||
(defun view-wizard (win)
|
||||
"Render setup wizard overlay: step title, prompt, input, error, progress."
|
||||
(clear win)
|
||||
(box win (theme-color :border) (theme-color :background))
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
|
||||
(box win 0 0)
|
||||
(let* ((w (or (width win) 60))
|
||||
(h (or (height win) 15))
|
||||
(y 1)
|
||||
|
||||
Reference in New Issue
Block a user