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
@@ -31,7 +31,7 @@ Event handlers + daemon I/O + main loop.
|
||||
render/input event loop at ~30fps.
|
||||
|
||||
** Event Handlers
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun on-key (&rest args)
|
||||
@@ -114,7 +114,7 @@ Event handlers + daemon I/O + main loop.
|
||||
when content
|
||||
do (let ((pos (or (search "https://" content) (search "http://" content))))
|
||||
(when pos
|
||||
(let ((end (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
|
||||
(let ((end (or (position-if (lambda (c) (find c (list #\Space #\Newline #\Tab (code-char 41))))
|
||||
content :start pos)
|
||||
(length content))))
|
||||
(setf url (subseq content pos end))
|
||||
@@ -729,10 +729,10 @@ Event handlers + daemon I/O + main loop.
|
||||
((eq action :handshake)
|
||||
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
|
||||
(t (add-msg :agent (format nil "~a" msg))))))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
** Daemon Communication
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
|
||||
(defun send-daemon (msg)
|
||||
(let ((s (st :stream)))
|
||||
(when (and s (open-stream-p s))
|
||||
@@ -783,10 +783,10 @@ Event handlers + daemon I/O + main loop.
|
||||
while line
|
||||
do (push line (st :input-history))))
|
||||
(setf (st :input-history) (nreverse (st :input-history))))))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
** Connection
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
|
||||
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
||||
(add-msg :system "* Connecting to daemon... *")
|
||||
(loop for attempt from 1 to 3
|
||||
@@ -816,83 +816,92 @@ Event handlers + daemon I/O + main loop.
|
||||
(ignore-errors (close (st :stream)))
|
||||
(setf (st :stream) nil (st :connected) nil)
|
||||
(add-msg :system "* Disconnected *")))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
** Main Loop
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
(theme-load)
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
|
||||
(ch (- h 5))
|
||||
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
|
||||
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
|
||||
(swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
;; Store windows in state for SIGWINCH handler
|
||||
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(connect-daemon)
|
||||
(when (> swank-port 0)
|
||||
(handler-case
|
||||
(progn
|
||||
(ql:quickload :swank :silent t)
|
||||
(funcall (find-symbol "CREATE-SERVER" "SWANK")
|
||||
:port swank-port :dont-close t)
|
||||
(add-msg :system
|
||||
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
|
||||
(error ()
|
||||
(add-msg :system "* Swank unavailable *"))))
|
||||
;; Initial render before the main loop — otherwise the screen stays
|
||||
;; blank until the first keystroke (get-char blocks).
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(let ((ch (get-char iw)))
|
||||
(cond
|
||||
((or (not ch) (equal ch -1)) nil)
|
||||
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
|
||||
((eql ch 410)
|
||||
(let* ((new-h (or (height scr) 24))
|
||||
(new-w (or (width scr) 80))
|
||||
(new-ch (- new-h 5)))
|
||||
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
|
||||
ch new-ch
|
||||
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
|
||||
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
|
||||
w new-w
|
||||
h new-h)
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
(st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)))
|
||||
(t (on-key ch))))
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
(disconnect-daemon))))
|
||||
|
||||
#+end_src
|
||||
(let* ((swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(setf (st :dirty) (list t t t))
|
||||
(connect-daemon)
|
||||
(when (> swank-port 0)
|
||||
(handler-case
|
||||
(progn
|
||||
(ql:quickload :swank :silent t)
|
||||
(funcall (find-symbol "CREATE-SERVER" "SWANK")
|
||||
:port swank-port :dont-close t)
|
||||
(add-msg :system
|
||||
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
|
||||
(error ()
|
||||
(add-msg :system "* Swank unavailable *"))))
|
||||
(cl-tty.input:with-raw-terminal
|
||||
(cl-tty.backend:with-terminal (be w h)
|
||||
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
|
||||
(curr-fb (cl-tty.rendering:make-framebuffer w h)))
|
||||
;; Initial render
|
||||
(redraw be curr-fb w h)
|
||||
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
|
||||
(rotatef prev-fb curr-fb)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(multiple-value-bind (type data)
|
||||
(cl-tty.input:read-event be :timeout 0)
|
||||
(cond
|
||||
((eq type :resize)
|
||||
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
|
||||
(setf prev-fb (cl-tty.rendering:make-framebuffer w h)
|
||||
curr-fb (cl-tty.rendering:make-framebuffer w h))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(data
|
||||
(let ((ch (typecase data
|
||||
(cl-tty.input:key-event
|
||||
(cl-tty.input:key-event-key data))
|
||||
(t data))))
|
||||
(cond
|
||||
((eql ch :escape)
|
||||
(when (st :streaming-text)
|
||||
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
|
||||
(when (> (length (st :messages)) 0)
|
||||
(let ((idx (1- (length (st :messages)))))
|
||||
(setf (getf (aref (st :messages) idx) :content)
|
||||
(concatenate 'string
|
||||
(getf (aref (st :messages) idx) :content)
|
||||
" [interrupted]"))
|
||||
(setf (getf (aref (st :messages) idx) :streaming) nil)
|
||||
(setf (getf (aref (st :messages) idx) :time) (now))))
|
||||
(setf (st :streaming-text) nil)
|
||||
(setf (st :busy) nil)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
(when (st :search-mode)
|
||||
(setf (st :search-mode) nil
|
||||
(st :search-matches) nil
|
||||
(st :search-query) "")
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(add-msg :system "Search exited")))
|
||||
(t (on-key ch)))))))
|
||||
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
|
||||
(cl-tty.backend:backend-clear curr-fb)
|
||||
(redraw be curr-fb w h)
|
||||
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
|
||||
(rotatef prev-fb curr-fb))
|
||||
(sleep 0.1))))
|
||||
(disconnect-daemon))))
|
||||
#+END_SRC
|
||||
|
||||
* Test Suite
|
||||
#+begin_src lisp
|
||||
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
@@ -1367,4 +1376,4 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (st :scroll-offset) 3)
|
||||
(on-key :npage)
|
||||
(fiveam:is (= 0 (st :scroll-offset))))
|
||||
#+end_src
|
||||
#+END_SRC
|
||||
|
||||
@@ -17,9 +17,9 @@ All state mutation flows through event handlers in the controller.
|
||||
reader loop. (drain-queue) returns and clears the queue.
|
||||
|
||||
** 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
|
||||
@@ -121,8 +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."
|
||||
(or (getf *tui-theme* role) :white))
|
||||
"Returns a hex color string for a semantic role, suitable for cl-tty."
|
||||
(let ((val (or (getf *tui-theme* role) :white)))
|
||||
(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))
|
||||
@@ -140,10 +147,10 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:search-mode nil :search-query "" ; v0.7.2
|
||||
:search-matches nil :search-match-idx 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))
|
||||
@@ -177,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*)))
|
||||
|
||||
@@ -188,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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user