v0.8.0: complete cl-tty TUI migration — remove all Croatoan deps
- Replace numeric key code dispatch with cl-tty keyword events - Replace Croatoan code-key/key-name normalization with direct keyword dispatch - Update main loop to construct Ctrl-key keywords from cl-tty key-event modifiers - Remove croatoan-to-tty-event compatibility shim and its test - Remove duplicate Esc handling from main loop (now handled by on-key) - Update all documentation contracts, prose, docstrings to remove Croatoan refs - Remove :croatoan from package dependencies - All event handling now goes through cl-tty keymaps or keyword dispatch
This commit is contained in:
1
docs/.#ROADMAP.org
Symbolic link
1
docs/.#ROADMAP.org
Symbolic link
@@ -0,0 +1 @@
|
||||
user@amr.1407003:1778162380
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,14 +1,11 @@
|
||||
(defpackage :passepartout.channel-tui
|
||||
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
|
||||
(:use :cl :passepartout :usocket :bordeaux-threads)
|
||||
(:export :tui-main :st :add-msg :now :input-string
|
||||
:queue-event :drain-queue :init-state
|
||||
:view-status :view-chat :view-input :redraw
|
||||
:on-key :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*tui-theme* :theme-color
|
||||
:*slash-commands* :open-minibuffer :minibuffer-handle-key
|
||||
:view-conversation :render-user-msg :render-agent-msg
|
||||
:render-sys-msg :render-tool-call :render-gate-trace))
|
||||
:*tui-theme* :theme-color))
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defvar *state* nil)
|
||||
@@ -33,7 +30,7 @@
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
;; UI
|
||||
:dim :white :highlight :cyan :accent :green)
|
||||
"Color theme plist. 27 semantic keys → Croatoan color values.
|
||||
"Color theme plist. 27 semantic keys → hex color strings.
|
||||
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defvar *tui-theme-presets*
|
||||
@@ -68,43 +65,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
|
||||
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
|
||||
:rule-count "#2aa198" :focus-map "#b58900"
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900")
|
||||
:nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
|
||||
:input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
|
||||
:connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
|
||||
:gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
|
||||
:hitl "#b48ead"
|
||||
:tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
|
||||
:scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
|
||||
:rule-count "#88c0d0" :focus-map "#ebcb8b"
|
||||
:dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
|
||||
:tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
|
||||
:input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
|
||||
:connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
|
||||
:gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
|
||||
:hitl "#bb9af7"
|
||||
:tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
|
||||
:scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
|
||||
:rule-count "#7dcfff" :focus-map "#e0af68"
|
||||
:dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
|
||||
:catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
|
||||
:input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
|
||||
:connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
|
||||
:gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
|
||||
:hitl "#cba6f7"
|
||||
:tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
|
||||
:scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
|
||||
:rule-count "#94e2d5" :focus-map "#f9e2af"
|
||||
:dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
|
||||
:monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
|
||||
:input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
|
||||
:connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
|
||||
:gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
|
||||
:hitl "#ae81ff"
|
||||
:tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
|
||||
:scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
|
||||
:rule-count "#66d9ef" :focus-map "#e6db74"
|
||||
:dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900"))
|
||||
"Named theme presets. /theme <name> loads one into *tui-theme*.")
|
||||
|
||||
(defvar *tui-theme-current-name* :dark
|
||||
@@ -140,40 +101,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
key)))
|
||||
|
||||
(defun theme-color (role)
|
||||
"Returns the Croatoan color for a semantic role.
|
||||
Keyword or hex string values are returned as-is; hex strings are
|
||||
converted to integers that Croatoan can process."
|
||||
"Returns a hex color string for a semantic role, suitable for cl-tty."
|
||||
(let ((val (or (getf *tui-theme* role) :white)))
|
||||
(if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
|
||||
(handler-case (parse-integer (subseq val 1) :radix 16)
|
||||
(error () val))
|
||||
val)))
|
||||
|
||||
;; v0.8.0: TrueColor helpers
|
||||
(defun theme-hex-to-rgb (hex-string)
|
||||
"Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
|
||||
(if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
|
||||
(handler-case
|
||||
(let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
|
||||
(g (parse-integer (subseq hex-string 3 5) :radix 16))
|
||||
(b (parse-integer (subseq hex-string 5 7) :radix 16)))
|
||||
(values r g b))
|
||||
(error () (values 255 255 255)))
|
||||
(values 255 255 255)))
|
||||
|
||||
(defun theme-init-truecolor ()
|
||||
"Register hex colors from *tui-theme* with Croatoan's init-color."
|
||||
(handler-case
|
||||
(loop for (key val) on *tui-theme* by #'cddr
|
||||
when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
|
||||
do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
|
||||
(init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
|
||||
(error () nil)))
|
||||
|
||||
(defun sidebar-toggle ()
|
||||
"Toggle sidebar visibility. Sets dirty flags for full redraw."
|
||||
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(cond
|
||||
((stringp val) val)
|
||||
(t (case val
|
||||
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
|
||||
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
|
||||
(:white "#FFFFFF") (:black "#000000")
|
||||
(t "#FFFFFF"))))))
|
||||
|
||||
(defun st (key) (getf *state* key))
|
||||
(defun (setf st) (val key) (setf (getf *state* key) val))
|
||||
@@ -190,8 +126,6 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:collapsed-gates nil ; v0.7.2
|
||||
:search-mode nil :search-query "" ; v0.7.2
|
||||
:search-matches nil :search-match-idx 0
|
||||
:sidebar-visible nil ; v0.8.0
|
||||
:expand-tool-calls nil ; v0.8.0
|
||||
:dirty (list nil nil nil))))
|
||||
|
||||
(defun now ()
|
||||
|
||||
@@ -1,27 +1,25 @@
|
||||
(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)
|
||||
@@ -40,98 +38,23 @@
|
||||
(setf result (concatenate 'string result (subseq content pos)))
|
||||
(if (string= result "") content result))))
|
||||
|
||||
(defun render-user-msg (win content time w y)
|
||||
"Render a user message with green role-prefix and timestamp. Returns next y."
|
||||
(let* ((prefix (format nil "⬆ [~a] " time))
|
||||
(line-text (concatenate 'string prefix content))
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y 9999)
|
||||
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :user))
|
||||
(incf y)))
|
||||
y))
|
||||
|
||||
(defun render-agent-msg (win content time w y)
|
||||
"Render an agent message using cl-tty's markdown renderer. Returns next y."
|
||||
(let* ((prefix (format nil "⬇ [~a] " time))
|
||||
(header-len (length prefix)))
|
||||
;; Role prefix line
|
||||
(add-string win prefix :y y :x 1 :n header-len :fgcolor (theme-color :agent))
|
||||
(incf y)
|
||||
;; Markdown content — cl-tty's render-markdown produces ANSI-styled lines
|
||||
(let ((md-lines (cl-tty.markdown:render-md
|
||||
(cl-tty.markdown:parse-blocks content))))
|
||||
(dolist (line md-lines)
|
||||
(when (< y 9999)
|
||||
;; Each line may contain ANSI escape codes; render through add-string
|
||||
(add-string win line :y y :x 1 :n (- w 2) :fgcolor (theme-color :agent))
|
||||
(incf y))))
|
||||
y))
|
||||
|
||||
(defun render-sys-msg (win content w y)
|
||||
"Render a system message in yellow, dim style. Returns next y."
|
||||
(let* ((line-text (format nil " ~a" content))
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y 9999)
|
||||
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :system))
|
||||
(incf y)))
|
||||
y))
|
||||
|
||||
(defun render-tool-call (win tool-name status duration content w y tab-expanded)
|
||||
"Render a tool call with status indicator. Tab toggles full output. Returns next y."
|
||||
(let* ((status-char (case status (:running "…") (:success "✓") (:failure "✗") (t "?")))
|
||||
(status-color (case status (:running (theme-color :tool-running))
|
||||
(:success (theme-color :tool-success))
|
||||
(:failure (theme-color :tool-failure))
|
||||
(t (theme-color :dim))))
|
||||
(summary (format nil " ~a ~a~@[ (~,1fs)~]" status-char tool-name duration)))
|
||||
;; Summary line
|
||||
(add-string win summary :y y :x 1 :n (- w 2) :fgcolor status-color)
|
||||
(incf y)
|
||||
;; Expanded output (when Tab pressed)
|
||||
(when tab-expanded
|
||||
(dolist (line (word-wrap content (- w 6)))
|
||||
(when (< y 9999)
|
||||
(add-string win (format nil " ~a" line) :y y :x 1 :n (- w 4) :fgcolor (theme-color :tool-output))
|
||||
(incf y))))
|
||||
y))
|
||||
|
||||
(defun render-gate-trace (win trace w y collapsed)
|
||||
"Render gate decisions as colored lines. Ctrl+G toggles. Returns next y."
|
||||
(unless collapsed
|
||||
(dolist (entry (gate-trace-lines trace))
|
||||
(when (< y 9999)
|
||||
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
|
||||
(incf y))))
|
||||
y)
|
||||
|
||||
(defun view-conversation (win h)
|
||||
"Render scrolled message list using cl-tty ScrollBox model.
|
||||
Sticky-scroll: auto-follows new content when at bottom.
|
||||
Each message role dispatched to its dedicated render function."
|
||||
(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))
|
||||
(y 1))
|
||||
;; Search mode header
|
||||
;; v0.7.2: search mode header
|
||||
(when is-search
|
||||
(let* ((matches (st :search-matches))
|
||||
(idx (st :search-match-idx))
|
||||
(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)))
|
||||
;; Sticky-scroll: if at bottom, auto-follow
|
||||
(when (and (zerop (st :scroll-offset)) (> total 0))
|
||||
(setf (st :scroll-at-bottom) t))
|
||||
;; Count visible messages from end
|
||||
;; Count visible messages from end, accounting for word wrap
|
||||
(let* ((msg-count 0)
|
||||
(lines-remaining max-lines))
|
||||
(loop for i from (1- total) downto 0
|
||||
@@ -140,16 +63,17 @@
|
||||
(role (getf msg :role))
|
||||
(content (getf msg :content))
|
||||
(time (or (getf msg :time) ""))
|
||||
(nlines (case role
|
||||
(:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2))))
|
||||
(:agent (let ((header (format nil "⬇ [~a]" time)))
|
||||
(+ 1 (length (cl-tty.markdown:render-md
|
||||
(cl-tty.markdown:parse-blocks content))))))
|
||||
(t (length (word-wrap (format nil " ~a" content) (- w 2)))))))
|
||||
(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)
|
||||
(progn (decf lines-remaining nlines) (incf msg-count))
|
||||
(setf lines-remaining 0))))
|
||||
;; Render from start message
|
||||
;; Render from the correct starting message
|
||||
(let* ((scroll-skip (st :scroll-offset))
|
||||
(start (max 0 (- total msg-count scroll-skip))))
|
||||
(loop for i from start below total
|
||||
@@ -158,156 +82,48 @@
|
||||
(role (getf msg :role))
|
||||
(content (getf msg :content))
|
||||
(time (or (getf msg :time) ""))
|
||||
(gate-trace (getf msg :gate-trace))
|
||||
(collapsed (member i (st :collapsed-gates)))
|
||||
(tool-name (getf msg :tool))
|
||||
(tool-status (getf msg :tool-status))
|
||||
(tool-duration (getf msg :tool-duration))
|
||||
(tool-expanded (member i (st :expand-tool-calls))))
|
||||
(setf y (case role
|
||||
(:user (render-user-msg win content time w y))
|
||||
(:agent (progn
|
||||
(setf y (render-agent-msg win content time w y))
|
||||
(when gate-trace
|
||||
(setf y (render-gate-trace win gate-trace w y collapsed)))
|
||||
y))
|
||||
(t (render-sys-msg win content w y))))
|
||||
;; Tool call block (attached to any role message)
|
||||
(when tool-name
|
||||
(setf y (render-tool-call win tool-name tool-status tool-duration
|
||||
content w y tool-expanded)))))))
|
||||
;; Sticky-scroll update
|
||||
(when (and (st :scroll-at-bottom) (plusp (length msgs)))
|
||||
(setf (st :scroll-offset) 0))
|
||||
(refresh win)))
|
||||
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
|
||||
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
|
||||
(is-panel (getf msg :panel))
|
||||
(is-resolved (getf msg :panel-resolved))
|
||||
(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))))
|
||||
;; HITL panel: render with colored border
|
||||
(when is-panel
|
||||
(setf color (if is-resolved
|
||||
(theme-color :dim)
|
||||
(theme-color :hitl))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y (1- h))
|
||||
(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))
|
||||
(cl-tty.backend:draw-text fb 3 y (car entry)
|
||||
(or (getf (cdr entry) :fgcolor) :dim) nil)
|
||||
(incf y)))))))))))
|
||||
|
||||
(defun view-input (win)
|
||||
(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)))
|
||||
|
||||
(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-conversation cw ch))
|
||||
(when id (view-input iw))
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
(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))))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-tui-view-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:tui-view-suite))
|
||||
|
||||
(in-package :passepartout-tui-view-tests)
|
||||
|
||||
(def-suite tui-view-suite :description "TUI view rendering helpers")
|
||||
(in-suite tui-view-suite)
|
||||
|
||||
(test test-char-width-ascii
|
||||
"Contract 5: ASCII characters (< 128) have width 1."
|
||||
(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 (char-width #\Tab))))
|
||||
|
||||
(test test-char-width-cjk
|
||||
"Contract 5: CJK characters have width 2."
|
||||
(is (= 2 (char-width #\日))))
|
||||
|
||||
(test test-char-width-null
|
||||
"Contract 5: null has width 0."
|
||||
(is (= 0 (char-width #\Nul))))
|
||||
|
||||
(test test-markdown-bold
|
||||
"Contract 7: parse-markdown-spans detects **bold**."
|
||||
(let ((segments (parse-markdown-spans "hello **world**!")))
|
||||
(is (= 3 (length segments)))))
|
||||
|
||||
(test test-markdown-plain
|
||||
"Contract 7: plain text returns single segment."
|
||||
(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 (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 (parse-markdown-blocks text)))
|
||||
(is (= 3 (length segs)))
|
||||
(let ((code (second segs)))
|
||||
(is (eq t (getf code :code-block)))
|
||||
(is (string= "lisp" (getf code :lang)))
|
||||
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
|
||||
|
||||
(test test-markdown-blocks-no-close
|
||||
"Contract 8: unclosed code block returns content."
|
||||
(let* ((text (format nil "```~%unclosed code"))
|
||||
(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 (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 (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 (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 (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 (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 (gate-trace-lines
|
||||
'((:gate "network" :result :approval)))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (search "HITL" (caar lines)))))
|
||||
|
||||
(test test-init-state-has-collapsed-gates
|
||||
"Contract v0.7.2: init-state includes :collapsed-gates field."
|
||||
(passepartout.channel-tui::init-state)
|
||||
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
|
||||
(is (null cg))))
|
||||
|
||||
(in-package :passepartout.channel-tui)
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun char-width (ch)
|
||||
"Returns the terminal column width of character CH.
|
||||
@@ -331,35 +147,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
((<= #xFE00 code #xFE0F) 0)
|
||||
(t 1))))
|
||||
|
||||
(defun word-wrap (text max-width)
|
||||
"Split TEXT into lines that fit within MAX-WIDTH columns.
|
||||
Word-breaks at spaces when possible; breaks mid-word if necessary.
|
||||
Respects CJK/emoji char widths via char-width."
|
||||
(let ((lines nil)
|
||||
(start 0)
|
||||
(end (length text)))
|
||||
(loop while (< start end) do
|
||||
(let* ((col 0)
|
||||
(pos start)
|
||||
(last-break start))
|
||||
(loop while (< pos end)
|
||||
for width = (char-width (char text pos)) do
|
||||
(when (char= (char text pos) #\Space)
|
||||
(setf last-break pos))
|
||||
(when (> (+ col width) max-width)
|
||||
(return))
|
||||
(incf col width)
|
||||
(incf pos)
|
||||
(when (>= pos end) (return)))
|
||||
(let ((line-end (if (> pos start) pos (1+ start))))
|
||||
(when (>= line-end end) (setf line-end end))
|
||||
(push (subseq text start line-end) lines)
|
||||
(setf start (if (and (< line-end end) (char= (char text line-end) #\Space))
|
||||
(1+ line-end)
|
||||
line-end)))))
|
||||
(nreverse lines)))
|
||||
|
||||
(in-package :passepartout.channel-tui)
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun parse-markdown-spans (text)
|
||||
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
|
||||
@@ -399,28 +187,22 @@ Respects CJK/emoji char widths via char-width."
|
||||
(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))
|
||||
(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))
|
||||
: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)))
|
||||
(url (getf attrs :url)))
|
||||
(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))))
|
||||
(1+ y))
|
||||
y)
|
||||
|
||||
(defun parse-markdown-blocks (text)
|
||||
"Split text at ``` code block boundaries."
|
||||
@@ -484,7 +266,7 @@ Respects CJK/emoji char widths via char-width."
|
||||
(setf p fe)))))))))
|
||||
(nreverse r)))
|
||||
|
||||
(in-package :passepartout.channel-tui)
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun gate-trace-lines (trace)
|
||||
"Convert gate-trace plist to display lines."
|
||||
@@ -495,14 +277,14 @@ Respects CJK/emoji char widths via char-width."
|
||||
(reason (getf entry :reason))
|
||||
(name (or gate "unknown"))
|
||||
(color (case result
|
||||
(:passed (theme-color :gate-passed))
|
||||
(:blocked (theme-color :gate-blocked))
|
||||
(:approval (theme-color :gate-approval))
|
||||
(t (theme-color :dim))))
|
||||
(:passed :gate-passed)
|
||||
(:blocked :gate-blocked)
|
||||
(:approval :gate-approval)
|
||||
(t :dim)))
|
||||
(prefix (case result
|
||||
(:passed " ✓ ")
|
||||
(:blocked " ✗ ")
|
||||
(:approval " → ")
|
||||
(:passed " \u2713 ")
|
||||
(:blocked " \u2717 ")
|
||||
(:approval " \u2192 ")
|
||||
(t " ? ")))
|
||||
(text (format nil "~a~a~@[~a~]~@[~a~]"
|
||||
prefix name
|
||||
@@ -511,339 +293,110 @@ Respects CJK/emoji char widths via char-width."
|
||||
(push (cons text (list :fgcolor color)) lines)))
|
||||
(nreverse lines)))
|
||||
|
||||
(in-package :passepartout.channel-tui)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
;; ── Sidebar Panel Slots ──
|
||||
;; Each sidebar panel is a cl-tty slot registration with :mode :replace.
|
||||
;; The sidebar orchestrates them in order, passing (win w h y) and
|
||||
;; receiving the next y position.
|
||||
|
||||
(defun render-sidebar-panel-header (win w y title)
|
||||
(add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2)
|
||||
:fgcolor (theme-color :accent))
|
||||
(1+ y))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-gate-trace :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(let ((trace (st :gate-trace)))
|
||||
(setf y (render-sidebar-panel-header win w y "Gate Trace"))
|
||||
(if trace
|
||||
(dolist (entry (gate-trace-lines 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)))
|
||||
(incf y)))
|
||||
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
|
||||
y)))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-focus :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(declare (ignore h))
|
||||
(setf y (render-sidebar-panel-header win w y "Focus"))
|
||||
(add-string win (format nil " ~a" (or (st :foveal-id) "(none)"))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
|
||||
(+ y 2)))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-rules :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(declare (ignore h))
|
||||
(setf y (+ y 2))
|
||||
(setf y (render-sidebar-panel-header win w y "Rules"))
|
||||
(add-string win (format nil " Rules: ~d" (or (st :rule-count) 0))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
|
||||
(1+ y)))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-context :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(declare (ignore h))
|
||||
(setf y (+ y 2))
|
||||
(setf y (render-sidebar-panel-header win w y "Context"))
|
||||
(let* ((pct (or (st :context-usage) 0))
|
||||
(bar-width 30)
|
||||
(filled (min bar-width (floor (* pct bar-width) 100)))
|
||||
(gauge-color (cond ((< pct 50) (theme-color :connected))
|
||||
((< pct 80) (theme-color :warning))
|
||||
((< pct 95) (theme-color :tool-running))
|
||||
(t (theme-color :error)))))
|
||||
(add-string win (format nil " [~a~a] ~d%"
|
||||
(make-string filled :initial-element #\█)
|
||||
(make-string (- bar-width filled) :initial-element #\░)
|
||||
pct)
|
||||
:y y :x 2 :n (- w 4) :fgcolor gauge-color))
|
||||
(1+ y)))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-files :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(setf y (+ y 2))
|
||||
(setf y (render-sidebar-panel-header win w y "Files"))
|
||||
(let ((files (st :modified-files)))
|
||||
(if files
|
||||
(dolist (f files)
|
||||
(when (< y (1- h))
|
||||
(let ((fp (getf f :filepath))
|
||||
(added (getf f :lines-added))
|
||||
(removed (getf f :lines-removed)))
|
||||
(add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]"
|
||||
(subseq fp (max 0 (- (length fp) 30)))
|
||||
(when (> added 0) added)
|
||||
(when (> removed 0) removed))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
|
||||
(incf y))))
|
||||
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
|
||||
y)))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-cost :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(declare (ignore h))
|
||||
(setf y (+ y 2))
|
||||
(setf y (render-sidebar-panel-header win w y "Cost"))
|
||||
(let ((cost (st :session-cost)))
|
||||
(if cost
|
||||
(progn
|
||||
(add-string win (format nil " Total: $~,4f" (getf cost :total))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
|
||||
(incf y)
|
||||
(add-string win (format nil " Calls: ~d" (getf cost :calls))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
|
||||
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
|
||||
(1+ y))))
|
||||
|
||||
(cl-tty.slot:defslot :sidebar-protection :mode :replace
|
||||
:render-fn
|
||||
(lambda (win w h y)
|
||||
(setf y (+ y 2))
|
||||
(setf y (render-sidebar-panel-header win w y "Protection"))
|
||||
(let ((bc (st :block-counts)))
|
||||
(if (and bc (> (getf bc :total) 0))
|
||||
(let ((by-gate (getf bc :by-gate)))
|
||||
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
|
||||
(when (< y (1- h))
|
||||
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
|
||||
(incf y))))
|
||||
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
|
||||
y)))
|
||||
|
||||
(defun view-sidebar (win)
|
||||
"Render 42-column sidebar with panel slots: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
|
||||
(clear win)
|
||||
(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))
|
||||
(dolist (panel '(:sidebar-gate-trace :sidebar-focus :sidebar-rules
|
||||
:sidebar-context :sidebar-files :sidebar-cost
|
||||
:sidebar-protection))
|
||||
(let ((result (cl-tty.slot:slot-render panel win w h y)))
|
||||
(when result (setf y (min (1- h) result)))))
|
||||
(refresh win)
|
||||
(1- y)))
|
||||
|
||||
(defun view-minibuffer (win)
|
||||
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
|
||||
(case (st :minibuffer-mode)
|
||||
(:slash-menu (view-slash-menu win))
|
||||
(:wizard (view-wizard-in-panel win))
|
||||
(t nil)))
|
||||
|
||||
(declaim (special *slash-commands*)) ; forward declaration — defined in channel-tui-main
|
||||
|
||||
(defun view-slash-menu (win)
|
||||
"Render the slash-command menu: filter bar, filtered command list, selection highlight."
|
||||
(clear win)
|
||||
(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) 10))
|
||||
(y 1)
|
||||
(filter (or (st :minibuffer-filter) ""))
|
||||
(commands passepartout.channel-tui::*slash-commands*)
|
||||
(filtered (if (or (null filter) (string= filter ""))
|
||||
(mapcar (lambda (c) (list :index (position c commands) :cmd c)) commands)
|
||||
(let ((q (string-downcase filter)) (i 0) (r nil))
|
||||
(dolist (c commands (nreverse r))
|
||||
(when (or (search q (string-downcase (getf c :name)))
|
||||
(search q (string-downcase (or (getf c :desc) ""))))
|
||||
(push (list :index i :cmd c) r))
|
||||
(incf i)))))
|
||||
(sel (or (st :minibuffer-selected-idx) 0))
|
||||
(max-visible (- h 3)))
|
||||
;; Header: filter bar
|
||||
(add-string win (format nil " Commands") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
|
||||
(incf y)
|
||||
(add-string win (format nil " > ~a_" (if (> (length filter) 0) filter "/"))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :input))
|
||||
(incf y)
|
||||
;; Command list
|
||||
(if filtered
|
||||
(let* ((start (max 0 (- sel (floor max-visible 2))))
|
||||
(end (min (length filtered) (+ start max-visible)))
|
||||
(flat-i 0))
|
||||
(loop for entry across (subseq (coerce filtered 'vector) start end)
|
||||
for fi from start
|
||||
for cmd = (getf entry :cmd)
|
||||
do (let* ((name (getf cmd :name))
|
||||
(desc (getf cmd :desc))
|
||||
(selected (= fi sel))
|
||||
(fg (if selected (theme-color :highlight) (theme-color :agent))))
|
||||
(when selected
|
||||
(add-string win (make-string (- w 4) :initial-element #\Space) :y y :x 2 :n (- w 4)
|
||||
:fgcolor (theme-color :dim) :bgcolor (theme-color :highlight)))
|
||||
(let ((prefix (if selected " > " " ")))
|
||||
(add-string win (format nil "~a~a" prefix name) :y y :x 3 :n (min (- w 6) 25) :fgcolor fg)
|
||||
(when desc
|
||||
(add-string win (format nil " — ~a" desc) :y y :x 28 :n (min (- w 30) (length desc)) :fgcolor (theme-color :dim))))
|
||||
(incf y))))
|
||||
(progn
|
||||
(add-string win " (no matching commands)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
|
||||
(incf y)))
|
||||
;; Footer
|
||||
(add-string win " ↑↓ Navigate Enter Execute Esc Close"
|
||||
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
|
||||
(refresh win)
|
||||
(- h 0)))
|
||||
|
||||
(defun view-wizard-in-panel (win)
|
||||
"Render the setup wizard in the bottom-anchored minibuffer panel. Three modes: provider-list, key-entry, cascade-config."
|
||||
(clear win)
|
||||
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
|
||||
(box win 0 0)
|
||||
(let* ((w (or (width win) 70))
|
||||
(h (or (height win) 14))
|
||||
(y 1)
|
||||
(mode (st :wizard-mode))
|
||||
(error-msg (st :wizard-error))
|
||||
(selected-idx (st :wizard-selected-idx))
|
||||
(providers (passepartout.channel-tui::wizard-provider-list))
|
||||
(configured (st :wizard-providers)))
|
||||
(add-string win "Setup Wizard" :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
|
||||
(incf y 2)
|
||||
(case mode
|
||||
(:provider-list
|
||||
(let ((count (/ (length configured) 2)))
|
||||
(add-string win (format nil "Configure Providers~a"
|
||||
(if (> count 0) (format nil " — ~d configured" count) ""))
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
|
||||
(incf y)
|
||||
(loop for p in providers
|
||||
for i from 0
|
||||
do (let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
|
||||
(name (car meta))
|
||||
(key (getf configured p))
|
||||
(prefix (if (= i selected-idx) "> " " "))
|
||||
(suffix (if key " ✓" ""))
|
||||
(color (if (= i selected-idx)
|
||||
(theme-color :highlight)
|
||||
(theme-color :dim))))
|
||||
(add-string win (format nil "~a~a~a" prefix name suffix)
|
||||
:y y :x 3 :n (- w 6) :fgcolor color)
|
||||
(incf y)))
|
||||
(incf y)
|
||||
(add-string win " Done — configure cascade"
|
||||
:y y :x 3 :n (- w 6)
|
||||
:fgcolor (if (>= selected-idx (length providers))
|
||||
(theme-color :highlight)
|
||||
(theme-color :dim)))
|
||||
(when (>= selected-idx (length providers))
|
||||
(add-string win ">" :y y :x 1 :n 2 :fgcolor (theme-color :highlight))))
|
||||
(:key-entry
|
||||
(let* ((provider (st :wizard-current-provider))
|
||||
(meta (passepartout.channel-tui::wizard-provider-meta provider))
|
||||
(name (car meta))
|
||||
(url (cadr meta))
|
||||
(input (or (st :wizard-input) "")))
|
||||
(add-string win (format nil "API Key: ~a" name) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
|
||||
(incf y)
|
||||
(when url
|
||||
(add-string win (format nil "Get key at: ~a" url) :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
|
||||
(incf y))
|
||||
(add-string win "Enter your API key." :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
|
||||
(incf y 2)
|
||||
(add-string win (format nil "Key: > ~a" input) :y y :x 3 :n (- w 6) :fgcolor (theme-color :input))
|
||||
(incf y)
|
||||
(when error-msg
|
||||
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error))
|
||||
(incf y))
|
||||
(incf y)
|
||||
(add-string win "Enter=Save Esc=Back Bksp=Edit Ctrl+U=Clear"
|
||||
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
|
||||
(return-from view-wizard-in-panel)))
|
||||
(:cascade-config
|
||||
(let* ((slot (st :wizard-cascade-slot))
|
||||
(slot-providers (getf (st :wizard-cascade) slot))
|
||||
(slot-label (cadr (assoc slot passepartout.channel-tui::*wizard-cascade-labels*)))
|
||||
(count (/ (length configured) 2)))
|
||||
(add-string win (format nil "Configure Cascade — ~d provider~:p" count)
|
||||
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
|
||||
(incf y)
|
||||
(add-string win (or slot-label "Unknown") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
|
||||
(incf y)
|
||||
(let ((shown nil))
|
||||
(loop for p in providers
|
||||
for i from 0
|
||||
do (when (getf configured p)
|
||||
(let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
|
||||
(name (car meta))
|
||||
(in-slot (member p slot-providers))
|
||||
(prefix (if (= i selected-idx) "> " " "))
|
||||
(mark (if in-slot " [✓]" " [ ]"))
|
||||
(color (if (= i selected-idx)
|
||||
(theme-color :highlight)
|
||||
(if in-slot (theme-color :gate-passed) (theme-color :dim)))))
|
||||
(add-string win (format nil "~a~a~a" prefix name mark)
|
||||
:y y :x 3 :n (- w 6) :fgcolor color)
|
||||
(incf y)
|
||||
(push t shown))))
|
||||
(unless shown
|
||||
(add-string win " (no providers configured)"
|
||||
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
|
||||
(incf y)))
|
||||
(incf y)
|
||||
(add-string win (format nil "Cascade: ~{~a~^, ~}"
|
||||
(or slot-providers '("(none)")))
|
||||
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))))
|
||||
(when error-msg
|
||||
(incf y)
|
||||
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error)))
|
||||
(let ((footer (case mode
|
||||
(:provider-list "↑↓ Navigate Enter=Select Esc=Back Ctrl+D=Remove")
|
||||
(:cascade-config "↑↓ Select Enter=Toggle Tab=Next Quadrant Ctrl+S=Save Esc=Back")
|
||||
(t ""))))
|
||||
(when footer
|
||||
(add-string win footer :y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))))
|
||||
(- h 0)))))
|
||||
(defpackage :passepartout-tui-view-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:tui-view-suite))
|
||||
|
||||
(in-package :passepartout-tui-view-tests)
|
||||
|
||||
(test test-theme-hex-string-keys-exist
|
||||
"v0.8.0: all 27 theme keys are present in *tui-theme*."
|
||||
(let* ((theme passepartout.channel-tui::*tui-theme*)
|
||||
(required '(:user :agent :system :input :timestamp :help :error :warning
|
||||
:connected :disconnected :busy :idle
|
||||
:gate-passed :gate-blocked :gate-approval :hitl
|
||||
:tool-running :tool-success :tool-failure :tool-output
|
||||
:scroll-indicator :border :background
|
||||
:rule-count :focus-map
|
||||
:dim :highlight :accent)))
|
||||
(dolist (key required)
|
||||
(is (getf theme key) (format nil "~a should be defined" key)))))
|
||||
(def-suite tui-view-suite :description "TUI view rendering helpers")
|
||||
(in-suite tui-view-suite)
|
||||
|
||||
(test test-theme-presets-count
|
||||
"v0.8.0: 8 presets defined: dark, light, solarized, gruvbox, nord, tokyonight, catppuccin, monokai."
|
||||
(let* ((presets passepartout.channel-tui::*tui-theme-presets*)
|
||||
(names '(:dark :light :solarized :gruvbox :nord :tokyonight :catppuccin :monokai)))
|
||||
(dolist (name names)
|
||||
(is (getf presets name) (format nil "~a preset should exist" name)))))
|
||||
(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 #\@))))
|
||||
|
||||
(test test-minibuffer-init-state-fields
|
||||
"Contract v0.8.0: init-state no longer has legacy palette/wizard fields."
|
||||
(test test-char-width-tab
|
||||
"Contract 5: tab character has width 8."
|
||||
(is (= 8 (passepartout::char-width #\Tab))))
|
||||
|
||||
(test test-char-width-cjk
|
||||
"Contract 5: CJK characters have width 2."
|
||||
(is (= 2 (passepartout::char-width #\日))))
|
||||
|
||||
(test test-char-width-null
|
||||
"Contract 5: null has width 0."
|
||||
(is (= 0 (passepartout::char-width #\Nul))))
|
||||
|
||||
(test test-markdown-bold
|
||||
"Contract 7: parse-markdown-spans detects **bold**."
|
||||
(let ((segments (passepartout::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")))
|
||||
(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")))
|
||||
(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)))
|
||||
(is (= 3 (length segs)))
|
||||
(let ((code (second segs)))
|
||||
(is (eq t (getf code :code-block)))
|
||||
(is (string= "lisp" (getf code :lang)))
|
||||
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
|
||||
|
||||
(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)))
|
||||
(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")))
|
||||
(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")))
|
||||
(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")))
|
||||
(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
|
||||
'((: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
|
||||
'((: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
|
||||
'((:gate "network" :result :approval)))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (search "HITL" (caar lines)))))
|
||||
|
||||
(test test-init-state-has-collapsed-gates
|
||||
"Contract v0.7.2: init-state includes :collapsed-gates field."
|
||||
(passepartout.channel-tui::init-state)
|
||||
(is (null (getf passepartout.channel-tui::*state* :mode)))
|
||||
(is (null (getf passepartout.channel-tui::*state* :palette-visible))))
|
||||
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
|
||||
(is (null cg))))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -6,66 +6,6 @@
|
||||
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
|
||||
All state mutation flows through event handlers in the controller.
|
||||
|
||||
** v0.8.0 — Information Radiator: Sidebar State
|
||||
|
||||
The sidebar is Passepartout's permanent UX differentiator — a 42-column
|
||||
information panel that renders architectural data no competitor can display
|
||||
because none has deterministic gates, foveal-peripheral context, or
|
||||
rule-synthesizing Dispatcher to feed it. The sidebar makes the invisible
|
||||
visible: seven panels of zero-LLM-token data from the deterministic layer,
|
||||
always on screen when terminal width permits.
|
||||
|
||||
The sidebar reads its data from daemon response fields enriched by the
|
||||
~:tui~ actuator in ~core-act.org~. All seven panels consume existing
|
||||
infrastructure: gate trace from ~cognitive-verify~ (v0.4.0), focus from
|
||||
~*loop-focus-id*~ (v0.3.0), rules from ~*hitl-pending*~ (v0.3.0), context
|
||||
from ~token-economics~ (v0.5.0), files from tool execution tracking
|
||||
(v0.8.0 new), cost from ~cost-tracker~ (v0.5.0), and block counts from
|
||||
the Dispatcher (v0.8.0 new). Each field arrives as a daemon-response
|
||||
plist key; the TUI stores them in state fields read by ~view-sidebar~.
|
||||
|
||||
When the terminal is narrower than 120 columns, the sidebar collapses to
|
||||
an overlay toggled via ~/sidebar~ or ~Ctrl+X+B~. This preserves the
|
||||
information radiator on constrained displays without sacrificing chat
|
||||
area real estate.
|
||||
|
||||
State additions: ~:sidebar-visible~ (boolean), ~:block-counts~ (alist),
|
||||
~:context-usage~ (integer 0-100), ~:modified-files~ (list of plists),
|
||||
~:session-cost~ (plist).
|
||||
|
||||
** v0.8.0 — TrueColor Theme System
|
||||
|
||||
The existing theme system uses Croatoan's standard 8-color palette
|
||||
(cyan, green, red, white, etc.). v0.8.0 upgrades to 24-bit TrueColor
|
||||
via Croatoan's ~set-rgb~ / ~init-color~ primitives, enabling hex-specified
|
||||
colors (#5E81AC, #BF616A, etc.) on supporting terminals (iTerm2, Kitty,
|
||||
WezTerm, Windows Terminal, Ghostty).
|
||||
|
||||
The upgrade is backward compatible: terminals without TrueColor fall
|
||||
back to the nearest standard color. Hex values are parsed by
|
||||
~theme-hex-to-rgb~ (one-line format string → integer triple) and
|
||||
registered once at theme-switch time via ~theme-init-truecolor~.
|
||||
Subsequent ~theme-color~ lookups return the Croatoan color ID, same
|
||||
API as the 8-color system.
|
||||
|
||||
Four new presets join the existing four (dark, light, solarized, gruvbox):
|
||||
- ~:nord~ — blue-gray backgrounds, frost accent
|
||||
- ~:tokyonight~ — purple-blue backgrounds, teal accent
|
||||
- ~:catppuccin~ — warm pastels, mauve accent
|
||||
- ~:monokai~ — dark brown backgrounds, orange accent
|
||||
|
||||
Each preset defines 27 hex color values, one per semantic key in
|
||||
~*tui-theme*~. The 27 keys are:
|
||||
roles (user, agent, system), content (input, timestamp, help, error,
|
||||
warning), status (connected, disconnected, busy, idle), gate trace
|
||||
(passed, blocked, approval, hitl), tools (running, success, failure,
|
||||
output), display (scroll-indicator, border, background), differentiator
|
||||
(rule-count, focus-map), and UI (dim, highlight, accent).
|
||||
|
||||
An audit ensures every key from ~*tui-theme*~ is consumed by at least one
|
||||
rendering function in ~channel-tui-view.org~. Missing keys become invisible
|
||||
theme presets — defined but unused.
|
||||
|
||||
** Contract
|
||||
|
||||
1. (init-state): returns a fresh state plist with ~:msgs~ list,
|
||||
@@ -75,32 +15,17 @@ theme presets — defined but unused.
|
||||
and optional gate-trace from the daemon (v0.4.0).
|
||||
3. (queue-event ev): thread-safely enqueues an event for the
|
||||
reader loop. (drain-queue) returns and clears the queue.
|
||||
4. (theme-hex-to-rgb hex-string): parses ~"#RRGGBB"~ to
|
||||
~(values r g b)~ integers 0-255. Returns ~(values 255 255 255)~
|
||||
for unparseable input (v0.8.0).
|
||||
5. (theme-init-truecolor): registers hex color values from
|
||||
~*tui-theme*~ with Croatoan's ~init-color~ / ~set-rgb~. No-op
|
||||
on terminals without TrueColor support (v0.8.0).
|
||||
6. (theme-color key): extended contract (v0.8.0): if the ~*tui-theme*~
|
||||
entry for ~key~ is a hex string, returns the Croatoan color ID
|
||||
registered by ~theme-init-truecolor~. Falls back to keyword
|
||||
lookup for non-hex entries and non-TrueColor terminals.
|
||||
7. (sidebar-toggle): toggles ~:sidebar-visible~ state. Sets dirty
|
||||
flags to force sidebar redraw (v0.8.0).
|
||||
|
||||
** Package + State
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
|
||||
(defpackage :passepartout.channel-tui
|
||||
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
|
||||
(:use :cl :passepartout :usocket :bordeaux-threads)
|
||||
(:export :tui-main :st :add-msg :now :input-string
|
||||
:queue-event :drain-queue :init-state
|
||||
:view-status :view-chat :view-input :redraw
|
||||
:on-key :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*tui-theme* :theme-color
|
||||
:*slash-commands* :open-minibuffer :minibuffer-handle-key
|
||||
:view-conversation :render-user-msg :render-agent-msg
|
||||
:render-sys-msg :render-tool-call :render-gate-trace))
|
||||
:*tui-theme* :theme-color))
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defvar *state* nil)
|
||||
@@ -125,7 +50,7 @@ theme presets — defined but unused.
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
;; UI
|
||||
:dim :white :highlight :cyan :accent :green)
|
||||
"Color theme plist. 27 semantic keys → Croatoan color values.
|
||||
"Color theme plist. 27 semantic keys → hex color strings.
|
||||
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defvar *tui-theme-presets*
|
||||
@@ -160,43 +85,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
|
||||
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
|
||||
:rule-count "#2aa198" :focus-map "#b58900"
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900")
|
||||
:nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b"
|
||||
:input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b"
|
||||
:connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88"
|
||||
:gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b"
|
||||
:hitl "#b48ead"
|
||||
:tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9"
|
||||
:scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440"
|
||||
:rule-count "#88c0d0" :focus-map "#ebcb8b"
|
||||
:dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac")
|
||||
:tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68"
|
||||
:input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68"
|
||||
:connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89"
|
||||
:gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68"
|
||||
:hitl "#bb9af7"
|
||||
:tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5"
|
||||
:scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26"
|
||||
:rule-count "#7dcfff" :focus-map "#e0af68"
|
||||
:dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7")
|
||||
:catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af"
|
||||
:input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af"
|
||||
:connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086"
|
||||
:gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af"
|
||||
:hitl "#cba6f7"
|
||||
:tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4"
|
||||
:scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e"
|
||||
:rule-count "#94e2d5" :focus-map "#f9e2af"
|
||||
:dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa")
|
||||
:monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74"
|
||||
:input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74"
|
||||
:connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e"
|
||||
:gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74"
|
||||
:hitl "#ae81ff"
|
||||
:tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2"
|
||||
:scroll-indicator "#66d9ef" :border "#49483e" :background "#272822"
|
||||
:rule-count "#66d9ef" :focus-map "#e6db74"
|
||||
:dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e"))
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900"))
|
||||
"Named theme presets. /theme <name> loads one into *tui-theme*.")
|
||||
|
||||
(defvar *tui-theme-current-name* :dark
|
||||
@@ -232,40 +121,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
key)))
|
||||
|
||||
(defun theme-color (role)
|
||||
"Returns the Croatoan color for a semantic role.
|
||||
Keyword or hex string values are returned as-is; hex strings are
|
||||
converted to integers that Croatoan can process."
|
||||
"Returns a hex color string for a semantic role, suitable for cl-tty."
|
||||
(let ((val (or (getf *tui-theme* role) :white)))
|
||||
(if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#))
|
||||
(handler-case (parse-integer (subseq val 1) :radix 16)
|
||||
(error () val))
|
||||
val)))
|
||||
|
||||
;; v0.8.0: TrueColor helpers
|
||||
(defun theme-hex-to-rgb (hex-string)
|
||||
"Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input."
|
||||
(if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#))
|
||||
(handler-case
|
||||
(let ((r (parse-integer (subseq hex-string 1 3) :radix 16))
|
||||
(g (parse-integer (subseq hex-string 3 5) :radix 16))
|
||||
(b (parse-integer (subseq hex-string 5 7) :radix 16)))
|
||||
(values r g b))
|
||||
(error () (values 255 255 255)))
|
||||
(values 255 255 255)))
|
||||
|
||||
(defun theme-init-truecolor ()
|
||||
"Register hex colors from *tui-theme* with Croatoan's init-color."
|
||||
(handler-case
|
||||
(loop for (key val) on *tui-theme* by #'cddr
|
||||
when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#))
|
||||
do (multiple-value-bind (r g b) (theme-hex-to-rgb val)
|
||||
(init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0))))
|
||||
(error () nil)))
|
||||
|
||||
(defun sidebar-toggle ()
|
||||
"Toggle sidebar visibility. Sets dirty flags for full redraw."
|
||||
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(cond
|
||||
((stringp val) val)
|
||||
(t (case val
|
||||
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
|
||||
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
|
||||
(:white "#FFFFFF") (:black "#000000")
|
||||
(t "#FFFFFF"))))))
|
||||
|
||||
(defun st (key) (getf *state* key))
|
||||
(defun (setf st) (val key) (setf (getf *state* key) val))
|
||||
@@ -282,13 +146,11 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:collapsed-gates nil ; v0.7.2
|
||||
:search-mode nil :search-query "" ; v0.7.2
|
||||
:search-matches nil :search-match-idx 0
|
||||
:sidebar-visible nil ; v0.8.0
|
||||
:expand-tool-calls nil ; v0.8.0
|
||||
:dirty (list nil nil nil))))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
** Helpers
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
|
||||
(defun now ()
|
||||
(multiple-value-bind (s m h) (get-decoded-time)
|
||||
(declare (ignore s))
|
||||
@@ -322,10 +184,10 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
(unless (st :scroll-at-bottom)
|
||||
(setf (st :scroll-notify) t))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
** Event Queue
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
|
||||
(defun queue-event (ev)
|
||||
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
|
||||
|
||||
@@ -333,4 +195,4 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
(bt:with-lock-held (*event-lock*)
|
||||
(let ((evs (nreverse *event-queue*)))
|
||||
(setf *event-queue* nil) evs)))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -6,7 +6,7 @@
|
||||
:description "The Probabilistic-Deterministic Lisp Machine"
|
||||
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
|
||||
:serial t
|
||||
:components ((:file "lisp/core-package")
|
||||
:components ((:file "lisp/core-package")
|
||||
(:file "lisp/core-skills")
|
||||
(:file "lisp/core-transport")
|
||||
(:file "lisp/core-memory")
|
||||
@@ -16,7 +16,7 @@
|
||||
(:file "lisp/core-pipeline")))
|
||||
|
||||
(defsystem :passepartout/tui
|
||||
:depends-on (:passepartout :croatoan :cl-tty :usocket :bordeaux-threads)
|
||||
:depends-on (:passepartout :cl-tty :usocket :bordeaux-threads)
|
||||
:serial t
|
||||
:components ((:file "lisp/channel-tui-state")
|
||||
(:file "lisp/channel-tui-view")
|
||||
|
||||
Reference in New Issue
Block a user