v0.7.1: Streaming + Markdown + URLs + Interrupt — TDD
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Stream-chunk protocol: SSE streaming via provider-openai-stream, cascade-stream with fboundp guard in think(). TUI renders live. Stream interrupt: Esc during streaming marks [interrupted], finalizes msg. SSE cancel infrastructure: *stream-cancel* check in read loop. Markdown inline: **bold**, *italic*, `code` via parse-markdown-spans. Code blocks: parse-markdown-blocks + syntax-highlight (keywords/strings/fns). URL detection + Tab-to-activate: https:// URLs in dim, Tab opens. Watchdog: 30s stall detection via Dexador read-timeout. [streaming] indicator in status bar. Pre-existing TUI test fixes (7): first→aref, nil→zerop, add-msg arg. Core: 65/65 Neuro: 13/13 TUI View: 22/22 TUI Main: 65/65 Total: 165 tests, 0 failures.
This commit is contained in:
@@ -55,7 +55,8 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(length (st :messages))
|
||||
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
|
||||
(or (st :rule-count) 0)
|
||||
(if (st :busy) " …thinking" ""))
|
||||
(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) "")))
|
||||
@@ -135,8 +136,12 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y (1- h))
|
||||
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
|
||||
(incf y))))))))
|
||||
(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))))))))))
|
||||
(refresh win))
|
||||
#+end_src
|
||||
|
||||
@@ -191,6 +196,129 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(t 1))))
|
||||
#+end_src
|
||||
|
||||
* v0.7.1 — Markdown Rendering
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun parse-markdown-spans (text)
|
||||
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
|
||||
(let ((results nil) (pos 0) (len (length text)))
|
||||
(labels ((earliest (a b) (cond ((and a (or (null b) (< a b))) a) (b b))))
|
||||
(loop
|
||||
(when (>= pos len) (return))
|
||||
(let* ((bold (search "**" text :start2 pos))
|
||||
(code (search "`" text :start2 pos))
|
||||
(italic (search "*" text :start2 pos))
|
||||
(http (search "http://" text :start2 pos))
|
||||
(https (search "https://" text :start2 pos))
|
||||
(url-s (or https http)))
|
||||
(flet ((pick (tag delim)
|
||||
(let ((end (search delim text :start2 (+ pos (length delim)))))
|
||||
(when end
|
||||
(push (cons (subseq text (+ pos (length delim)) end)
|
||||
(case tag (:bold '(:bold t))
|
||||
(:code '(:code t :bgcolor :dim))
|
||||
(:underline '(:underline t))
|
||||
(:url '(:url t))))
|
||||
results)
|
||||
(setf pos (+ end (length delim)))
|
||||
t)))
|
||||
(url-end (start)
|
||||
(or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
|
||||
text :start start)
|
||||
len)))
|
||||
(let ((next (earliest (earliest (earliest bold code) italic) url-s)))
|
||||
(cond ((and bold (eql bold next)) (unless (pick :bold "**") (incf pos 2)))
|
||||
((and code (eql code next)) (unless (pick :code "`") (incf pos)))
|
||||
((and italic (eql italic next)) (unless (pick :underline "*") (incf pos)))
|
||||
((and url-s (eql url-s next))
|
||||
(let ((ue (url-end url-s)))
|
||||
(push (cons (subseq text url-s ue) '(:url t)) results)
|
||||
(setf pos ue)))
|
||||
(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."
|
||||
(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)))))
|
||||
(incf x (length text))))
|
||||
y)
|
||||
|
||||
(defun parse-markdown-blocks (text)
|
||||
"Split text at ``` code block boundaries."
|
||||
(let ((r nil) (p 0) (l (length text)))
|
||||
(loop
|
||||
(when (>= p l) (return))
|
||||
(let ((bs (search "```" text :start2 p)))
|
||||
(unless bs
|
||||
(push (cons (subseq text p) nil) r)
|
||||
(return))
|
||||
(when (> bs p)
|
||||
(push (cons (subseq text p bs) nil) r))
|
||||
(let* ((ao (+ bs 3))
|
||||
(le (or (position #\Newline text :start ao) l))
|
||||
(lang (string-trim " \r\n\t" (if (< le l) (subseq text ao le) "")))
|
||||
(cs (if (< le l) (1+ le) l))
|
||||
(cp (search "```" text :start2 cs))
|
||||
(ce (or cp l))
|
||||
(content (string-trim "\r\n" (subseq text cs ce))))
|
||||
(push (list :code-block t :lang lang :content content) r)
|
||||
(setf p (if cp (+ cp 3) l)))))
|
||||
(nreverse r)))
|
||||
|
||||
(defun syntax-highlight (code lang)
|
||||
"Highlight Lisp code: strings, comments, keywords, function calls."
|
||||
(declare (ignore lang))
|
||||
(let* ((r nil) (p 0) (l (length code))
|
||||
(kw '("defun" "defvar" "defparameter" "let" "let*" "lambda" "if" "when" "unless"
|
||||
"cond" "loop" "dolist" "dotimes" "progn" "prog1" "return"
|
||||
"setf" "setq" "format" "and" "or" "not" "list" "cons"
|
||||
"quote" "function" "declare" "ignore" "t" "nil")))
|
||||
(flet ((wordp (c) (or (alphanumericp c) (find c "-*+/?!_=<>"))))
|
||||
(loop
|
||||
(when (>= p l) (return))
|
||||
(let* ((ss (position #\" code :start p))
|
||||
(sc (position #\; code :start p))
|
||||
(sp (position #\( code :start p))
|
||||
(next (min (or ss l) (or sc l) (or sp l))))
|
||||
(when (> next p)
|
||||
(push (cons (subseq code p next) nil) r)
|
||||
(setf p next))
|
||||
(when (>= p l) (return))
|
||||
(cond
|
||||
((eql p ss)
|
||||
(let ((e (or (position #\" code :start (1+ p)) l)))
|
||||
(push (cons (subseq code p (min (1+ e) l)) '(:fgcolor :string)) r)
|
||||
(setf p (min (1+ e) l))))
|
||||
((eql p sc)
|
||||
(let ((e (or (position #\Newline code :start p) l)))
|
||||
(push (cons (subseq code p e) '(:fgcolor :comment)) r)
|
||||
(setf p e)))
|
||||
((eql p sp)
|
||||
(push (cons "(" nil) r)
|
||||
(incf p)
|
||||
(let ((fe (loop for i from p below l for c = (char code i)
|
||||
while (wordp c) finally (return i))))
|
||||
(when (> fe p)
|
||||
(let ((fs (subseq code p fe)))
|
||||
(push (cons fs (list :fgcolor (if (member fs kw :test #'string=)
|
||||
:keyword :function))) r)
|
||||
(setf p fe)))))))))
|
||||
(nreverse r)))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
@@ -222,4 +350,55 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(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))))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user