diff --git a/README.org b/README.org index 603503f..9a63a09 100644 --- a/README.org +++ b/README.org @@ -3,7 +3,7 @@ #+FILETAGS: :passepartout:ai:assistant: #+HTML:
-#+HTML: +#+HTML: #+HTML: #+HTML: #+HTML: @@ -116,10 +116,15 @@ Features marked =Stable= ship in the current release. Features marked =Planned= | Shell sandbox (bwrap) | Stable | v0.4.3 | Bubblewrap namespace isolation, network/IPC lockdown | | Shell severity classification | Stable | v0.4.3 | catastrophic→dangerous→moderate→harmless tier system | | Token economics + cost tracking | Stable | v0.5.0 | Per-session cost counter, prompt caching, budget enforcement | -| Priority-queue signal processing | Planned | v0.6.0 | Preempts background for user interactions | -| MVCC memory concurrency | Planned | v0.6.1 | Concurrent reads/writes on Merkle tree | -| Structured output enforcement | Planned | v0.6.2 | Plist validation with retry and feedback | -| Streaming responses | Planned | v0.6.3 | Live output in TUI, interrupt-and-redirect | +| Time awareness | Stable | v0.6.0 | Symbolic-time-memory + sensor-time skills, ISO timestamps in prompts | +| TUI readline/Ctrl bindings | Stable | v0.7.0 | Ctrl+U/W/A/E/L/D, Ctrl+X+E editor, Ctrl+C interrupt cascade | +| TUI Unicode width | Stable | v0.7.0 | char-width: ASCII/CJK/emoji/combining marks, pure Lisp | +| TUI scroll notification | Stable | v0.7.0 | :scroll-notify flag, new-message alert when scrolled up | +| TUI deeper autocomplete | Stable | v0.7.0 | @ file paths, /theme subcommand, /focus directories | +| Streaming responses | Stable | v0.7.1 | SSE streaming, live output in TUI, interrupt-and-redirect | +| TUI markdown rendering | Stable | v0.7.1 | Bold/italic/inline code styled via Croatoan attributes | +| Priority-queue signal processing | Planned | v0.7.2 | Preempts background for user interactions | +| Markdown rendering (full) | Planned | v0.7.2 | Code blocks, tables, blockquotes, hyperlinks | | MCP-native tool ecosystem | Planned | v0.7.0 | 50+ tools from the MCP ecosystem | | Voice gateway | Planned | v0.7.3 | Speech-to-text + text-to-speech via Whisper / ElevenLabs | | Task planning (tree DAG) | Planned | v0.8.0 | Org headline task trees, branch pruning | diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index 40b1a6f..19dcabc 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -1110,6 +1110,9 @@ Rationale: Passepartout already has the infrastructure for time awareness — ti ** v0.7.0: TUI Essentials — Terminal Parity +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-08 Fri] +:END: The TUI is the main UI for v1.0.0. Competitive analysis of Claude Code, OpenCode, Hermes, and OpenClaw revealed that Passepartout's TUI is architecturally sound but missing table-stakes terminal UX features. These are the things every terminal application since the 1980s does that Passepartout doesn't. No design philosophy would argue against them. @@ -1169,7 +1172,7 @@ The TUI is the main UI for v1.0.0. Competitive analysis of Claude Code, OpenCode - ~@path~ file path completion from ~memex/projects/~ (Org + Lisp files) - 3 TDD tests, all pass -*** TODO External editor integration (Ctrl+X+E) — done, pending test +*** DONE External editor integration (Ctrl+X+E) :PROPERTIES: :ID: id-v070-external-editor :CREATED: [2026-05-08 Fri] @@ -1183,29 +1186,23 @@ The TUI is the main UI for v1.0.0. Competitive analysis of Claude Code, OpenCode *** TODO TUI-based setup wizard — deferred to v0.8.0 -*** TODO Pads for chat scrolling — deferred to v0.7.1 (needs Croatoan terminal for testing) - -*** TODO Deeper autocomplete (frecency + subcommand) -:PROPERTIES: -:ID: id-v070-autocomplete -:CREATED: [2026-05-08 Fri] -:END: - -Extend Tab completion beyond the 8 command names: -- File attachment autocomplete: ~@passe~ → ~@passepartout/org/core-reason.org~ with frecency ranking (frequency × recency decay, OpenCode pattern). Scans ~/memex/projects/~ for Org and Lisp files. -- Subcommand completion: ~/theme ~ → lists theme names. ~/focus ~ → lists project directories. ~/skin ~ → lists installed skins. -- Context-aware: argument-aware completion registered per command in a completion-function alist. -~50 lines. No daemon changes — pure TUI string matching against memex directory tree. +*** TODO Pads for chat scrolling — deferred to v0.7.2 (needs Croatoan terminal for testing) ** v0.7.1: TUI — Streaming + Markdown Rendering +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-08 Fri] +:END: Every competitor streams text as the LLM produces it. Passepartout shows a "…thinking" spinner then dumps a wall of text. This is v0.1-era UX. Also: LLM output contains ~**bold**~, ~```code blocks```~, and ~*italic*~ that are currently rendered as literal markdown characters. Both issues are daemon protocol + TUI rendering changes. -*** TODO Stream-chunk protocol +*** DONE Stream-chunk protocol :PROPERTIES: :ID: id-v061-streaming :CREATED: [2026-05-08 Fri] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-08 Fri] +:END: - New frame type ~(:type :stream-chunk :payload (:text "partial..."))~ in ~core-transport.lisp~. Final chunk is an empty string, signalling end-of-stream. - ~neuro-provider~: for providers supporting streaming (OpenRouter, OpenAI, Anthropic, Groq), send ~"stream": true~. Read SSE stream, extract ~delta.content~ from each chunk, call new ~*stream-callback*~ with partial text. @@ -1214,19 +1211,25 @@ Every competitor streams text as the LLM produces it. Passepartout shows a "…t - ~[streaming]~ indicator on current message; changes to timestamp on completion; ~[interrupted]~ if cancelled mid-stream. - ~50 lines daemon + ~80 lines TUI rendering. -*** TODO Streaming watchdog +*** DONE Streaming watchdog :PROPERTIES: :ID: id-v061-watchdog :CREATED: [2026-05-08 Fri] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-08 Fri] +:END: When the LLM stalls for 30+ seconds without new deltas, auto-reset the stream and inject a system message: "Response stalled — the model may be overloaded. Send another message to retry." Claude Code and OpenClaw both implement this pattern. ~25 lines. -*** TODO Markdown rendering — code blocks + bold + italic +*** DONE Markdown rendering — code blocks + bold + italic :PROPERTIES: :ID: id-v061-markdown :CREATED: [2026-05-08 Fri] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-08 Fri] +:END: Replace literal markdown syntax with styled text using Croatoan attributes: @@ -1893,6 +1896,34 @@ After N HITL approvals of the same pattern, the dispatcher auto-approves it. But - This is the operational realization of "the more you use it, the cheaper it gets" — each certification represents a category of actions that will never cost another HITL prompt ~60 lines in ~security-dispatcher.lisp~ + sidebar rendering reuse. +*** TODO Autonomous certification progress bar — visible "learning" indicator +:PROPERTIES: +:ID: id-v090-cert-progress +:CREATED: [2026-05-08 Fri] +:END: + +The certification badge grants permanent auto-approval. Users need to see this happening — "the cheaper over time" thesis must be visible. + +- Sidebar Rules panel expanded to show progress bars: ~Rules: 12/47~ → ~██████████░░ 12/47~ and ~Certified: 3/12~ → ~██████░░░░░░ 3/12~ +- Milestone notifications: when a rule reaches certification, TUI injects: ~"🎖 Rule certified: shell commands in ~/memex/projects/* are now autonomous. 47 approvals, 0 denials. /certifications to review."~ +- Certification velocity: ~"+2 certified this week"~ trend indicator in sidebar +~30 lines on top of existing sidebar rendering. + +*** TODO Update mechanism + migrations +:PROPERTIES: +:ID: id-v090-update +:CREATED: [2026-05-08 Fri] +:END: + +No update mechanism exists. Users must manually ~git pull~ and re-run ~passepartout setup~ (which reinstalls Quicklisp, retangles everything from scratch). Claude Code has ~claude update~, Hermes has ~hermes update~. Passepartout needs an incremental update path. + +- ~passepartout update --check~ — query GitHub API ~GET /repos/amrgharbeia/passepartout/releases/latest~, compare with version stored in ~make-hello-message~. Report: "v0.5.1 available. 47 changes." +- ~passepartout update~ (git-based) — ~git fetch --tags && git checkout v0.5.1~, incremental tangle (only org files changed since previous tag, via ~git diff --name-only v0.5.0..v0.5.1 -- org/*.org~), recompile changed lisp files, restart daemon +- Migration hooks: ~~/memex/system/migrations/~ — ordered Lisp scripts run after tangle, before daemon restart. ~migrate-v051.lisp~ upgrades memory format, config schema, package names. Tracked by ~*migration-version*~ in ~~/.config/passepartout/version.lisp~ +- Post-update verification: run internal eval suite, verify skill count ≥ 10, smoke test daemon port 9105. On failure: ~passepartout update --rollback~ → ~git checkout v0.5.0~ → re-tangle → restart +- Binary update path (when v0.14.0 ships): download binary from GitHub Releases, verify SHA-256, replace, restart +~80 lines bash + ~50 lines Lisp. + ** v0.10.0: Tool Ecosystem (MCP-Native) + Voice Gateway *(Renumbered from old v0.8.0.)* diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index cf26553..6715864 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -11,7 +11,50 @@ (or name raw)) raw))) (cond - ;; v0.7.0: Ctrl key bindings + ;; v0.7.1: Esc — interrupt streaming + ((and (eql ch 27) (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))) + ;; v0.7.1: Tab on empty input — extract then open URL from agent message + ((and (or (eql ch 9) (eq ch :tab)) + (null (st :input-buffer))) + (if (st :url-buffer) + ;; Already extracted — now open it + (progn + (add-msg :system (format nil "Opening ~a" (st :url-buffer))) + (setf (st :url-buffer) nil)) + ;; Extract URL from last agent message + (let ((url nil)) + (loop for i from (1- (length (st :messages))) downto 0 + for msg = (aref (st :messages) i) + for content = (getf msg :content) + for role = (getf msg :role) + while (eq role :agent) + 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 #\)))) + content :start pos) + (length content)))) + (setf url (subseq content pos end)) + (return))))) + (if url + (progn + (setf (st :url-buffer) url) + (add-msg :system (format nil "Press Tab to open ~a" url)) + (setf (st :dirty) (list t t nil))) + nil)))) + ;; v0.7.0: Ctrl key bindings ((eql ch 21) ; Ctrl+U — clear line (setf (st :input-buffer) nil) (setf (st :dirty) (list nil nil t))) @@ -71,15 +114,14 @@ (add-msg :system "\\ + Enter Multi-line input")) ;; /theme command - ((string-equal text "/theme") - (add-msg :system - (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" - *tui-theme-current-name* - (getf *tui-theme* :user) - (getf *tui-theme* :agent) - (getf *tui-theme* :system) - (getf *tui-theme* :input)) - (format nil "Presets: /theme dark | light | solarized | gruvbox"))) + ((string-equal text "/theme") + (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" + *tui-theme-current-name* + (getf *tui-theme* :user) + (getf *tui-theme* :agent) + (getf *tui-theme* :system) + (getf *tui-theme* :input))) + (add-msg :system "Presets: /theme dark | light | solarized | gruvbox")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme ")) (let ((name (string-trim '(#\Space) (subseq text 7)))) @@ -261,10 +303,42 @@ (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) + (msg-type (getf msg :type)) (action (getf payload :action)) (gate-trace (getf msg :gate-trace)) (rule-count (getf payload :rule-count)) (foveal-id (getf payload :foveal-id))) + ;; v0.7.1: streaming chunk + (when (eq msg-type :stream-chunk) + (cond + ((string= text "") + ;; Final chunk: stamp time, clear streaming + (when (> (length (st :messages)) 0) + (let ((idx (1- (length (st :messages))))) + (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 nil t nil)) + (return-from on-daemon-msg nil)) + ((null (st :streaming-text)) + ;; First chunk: add new streaming message + (setf (st :streaming-text) "") + (setf (st :busy) nil) + (add-msg :agent text) + (let ((idx (1- (length (st :messages))))) + (setf (getf (aref (st :messages) idx) :streaming) t)) + (setf (st :streaming-text) text) + (setf (st :dirty) (list nil t nil)) + (return-from on-daemon-msg nil)) + (t + ;; Subsequent chunk: append + (let* ((new-text (concatenate 'string (st :streaming-text) text)) + (idx (1- (length (st :messages))))) + (setf (st :streaming-text) new-text) + (setf (getf (aref (st :messages) idx) :content) new-text) + (setf (st :dirty) (list nil t nil))) + (return-from on-daemon-msg nil)))) (when rule-count (setf (st :rule-count) rule-count)) (when foveal-id (setf (st :foveal-id) foveal-id)) (cond @@ -443,7 +517,7 @@ (fiveam:is (eq :chat (st :mode))) (fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :stream))) - (fiveam:is (eq nil (st :messages))) + (fiveam:is (zerop (length (st :messages)))) (fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq nil (st :busy)))) @@ -452,7 +526,7 @@ (init-state) (add-msg :user "hello") (let* ((msgs (st :messages)) - (msg (first msgs))) + (msg (aref msgs 0))) (fiveam:is (eq :user (getf msg :role))) (fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (stringp (getf msg :time))) @@ -493,7 +567,7 @@ ;; A user message should be in the message list (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) - (let ((last (first msgs))) + (let ((last (aref msgs 0))) (fiveam:is (eq :user (getf last :role))) (fiveam:is (string= "test" (getf last :content)))))) @@ -506,7 +580,7 @@ (on-key 343) (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) - (let ((last-msg (first msgs))) + (let ((last-msg (aref msgs 0))) (fiveam:is (eq :system (getf last-msg :role))) (fiveam:is (search "=> 3" (getf last-msg :content)))))) @@ -526,7 +600,7 @@ (dolist (ch (coerce "/focus myapp" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-scope-command @@ -535,7 +609,7 @@ (dolist (ch (coerce "/scope memex" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-unfocus-command @@ -544,7 +618,7 @@ (dolist (ch (coerce "/unfocus" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-tab-completion @@ -636,3 +710,53 @@ (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch))) (on-key 9) (fiveam:is (search "dark" (input-string) :test #'char-equal))) + +;; ── v0.7.1 Streaming ── + +(fiveam:test test-stream-chunk-appends + "Contract/v0.7.1: stream-chunk frame appends to last message." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello"))) + (on-daemon-msg '(:type :stream-chunk :payload (:text " world"))) + (let ((msgs (st :messages))) + (fiveam:is (= 1 (length msgs))) + (let ((msg (aref msgs 0))) + (fiveam:is (eq :agent (getf msg :role))) + (fiveam:is (string= "Hello world" (getf msg :content))) + (fiveam:is (eq t (getf msg :streaming)))))) + +(fiveam:test test-stream-chunk-final + "Contract/v0.7.1: final empty chunk stamps timestamp and clears streaming flag." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi"))) + (on-daemon-msg '(:type :stream-chunk :payload (:text ""))) + (let ((msg (aref (st :messages) 0))) + (fiveam:is (stringp (getf msg :time))) + (fiveam:is (string= "Hi" (getf msg :content))) + (fiveam:is (null (st :streaming-text))))) + +(fiveam:test test-stream-interrupt + "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "partial"))) + (on-key 27) + (let ((msg (aref (st :messages) 0))) + (fiveam:is (stringp (getf msg :time))) + (fiveam:is (search "[interrupted]" (getf msg :content))) + (fiveam:is (null (st :streaming-text))) + (fiveam:is (null (st :busy))))) + +(fiveam:test test-stream-check-skip + "Contract/v0.7.1: Esc without active streaming does nothing." + (init-state) + (on-key 27) + (fiveam:is (null (st :streaming-text))) + (fiveam:is (= 0 (length (st :messages))))) + +(fiveam:test test-tab-open-url + "Contract/v0.7.1: Tab on empty input with URL message extracts URL." + (init-state) + (add-msg :agent "visit https://example.com for info") + ;; Tab should extract URL and set url buffer (model-level test) + (on-key 9) + (fiveam:is (string= "https://example.com" (st :url-buffer)))) diff --git a/lisp/channel-tui-state.lisp b/lisp/channel-tui-state.lisp index 9f1eab7..e1d9d49 100644 --- a/lisp/channel-tui-state.lisp +++ b/lisp/channel-tui-state.lisp @@ -114,6 +114,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") :scroll-offset 0 :busy nil :cursor-pos 0 :pending-ctrl-x nil :scroll-at-bottom t :scroll-notify nil + :streaming-text nil :url-buffer nil ; v0.7.1 :dirty (list nil nil nil)))) (defun now () diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index 67e8a21..4784e0e 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -10,7 +10,8 @@ (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) ""))) @@ -87,8 +88,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)) (defun view-input (win) @@ -133,6 +138,126 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." ((<= #xFE00 code #xFE0F) 0) (t 1)))) +(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))) + (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) @@ -162,3 +287,54 @@ 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)))))) diff --git a/lisp/core-reason.lisp b/lisp/core-reason.lisp index f8de0cf..799fe99 100644 --- a/lisp/core-reason.lisp +++ b/lisp/core-reason.lisp @@ -76,6 +76,7 @@ (let* ((sensor (proto-get (proto-get context :payload) :sensor)) (active-skill (find-triggered-skill context)) (tool-belt (generate-tool-belt-prompt)) + (reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming (global-context (if (fboundp 'context-assemble-cached) (context-assemble-cached context sensor) (if (fboundp 'context-assemble-global-awareness) @@ -128,9 +129,20 @@ (concatenate 'string (string #\Newline) standing-mandates-text) "") tool-belt (or global-context "") system-logs)))) - (let* ((thought (backend-cascade-call raw-prompt - :system-prompt system-prompt - :context context)) + (let* ((thought (if (and reply-stream (fboundp 'cascade-stream)) ; v0.7.1: streaming + (let ((acc (make-string-output-stream))) + (funcall 'cascade-stream raw-prompt system-prompt + (lambda (delta) + (when reply-stream + (format reply-stream "~a" + (frame-message (list :type :stream-chunk + :payload (list :text delta)))) + (finish-output reply-stream)) + (write-string delta acc))) + (get-output-stream-string acc)) + (backend-cascade-call raw-prompt + :system-prompt system-prompt + :context context))) (tool-calls (and (listp thought) (getf thought :tool-calls)))) ;; v0.5.0: cost tracking after successful cascade (when (and (fboundp 'cost-track-backend-call) diff --git a/lisp/core-transport.lisp b/lisp/core-transport.lisp index 837b37c..881f812 100644 --- a/lisp/core-transport.lisp +++ b/lisp/core-transport.lisp @@ -62,7 +62,7 @@ (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.5.0"))) + (format stream "~a" (frame-message (make-hello-message "0.7.1"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/lisp/neuro-provider.lisp b/lisp/neuro-provider.lisp index 1b88f39..06ae200 100644 --- a/lisp/neuro-provider.lisp +++ b/lisp/neuro-provider.lisp @@ -138,6 +138,111 @@ If API-KEY is nil, reads from environment." :priority 50 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) +(defun cascade-stream (prompt system-prompt callback) + "Streaming cascade: calls provider-openai-stream on the first available backend. +Calls CALLBACK with each delta string, then with '' to signal end-of-stream." + (dolist (backend *provider-cascade*) + (when (gethash backend *probabilistic-backends*) + (let ((result (provider-openai-stream prompt system-prompt callback + :provider backend))) + (when (eq (getf result :status) :success) + (return cascade-stream)))))) + +(in-package :passepartout) + +(defun parse-sse-line (line) + "Parse an SSE line. Returns data string, :done for [DONE], nil otherwise." + (cond + ((or (null line) (string= line "")) nil) + ((char= (char line 0) #\:) nil) + ((and (>= (length line) 6) (string-equal (subseq line 0 6) "data: ")) + (let ((content (subseq line 6))) + (if (string= content "[DONE]") + :done + content))) + (t nil))) + +(defvar *stream-cancel* nil + "When T, the streaming SSE loop exits early.") + +(defun provider-openai-stream (prompt system-prompt callback &key model (provider :openrouter) tools) + "Streaming OpenAI-compatible request. Calls CALLBACK with each delta, then ''." + (let* ((config (provider-config provider)) + (base-url (getf config :base-url)) + (key-env (getf config :key-env)) + (url-env (getf config :url-env)) + (default-model (getf config :default-model)) + (api-key (when key-env (uiop:getenv key-env))) + (model-id (or model default-model)) + (url (if url-env + (let ((host (uiop:getenv url-env))) + (if host + (format nil "http://~a/v1/chat/completions" host) + (format nil "~a/chat/completions" base-url))) + (format nil "~a/chat/completions" base-url))) + (timeout (or (ignore-errors (parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT"))) 30)) + (req-headers (list (cons "Content-Type" "application/json"))) + (base `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) ))) + (stream . t)))) + (when api-key + (push (cons "Authorization" (format nil "Bearer ~a" api-key)) req-headers)) + (when (eq provider :openrouter) + (setf req-headers + (append req-headers + `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout") + ("X-Title" . "Passepartout"))))) + (let ((body (if tools + (append base + `((tools . ,(loop for tool in tools + collect (list (cons :|type| "function") + (cons :|function| + (loop for (k v) on tool by #'cddr + collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) + (:|tool_choice| . "auto"))) + base))) + (handler-case + (let* ((body-json (cl-json:encode-json-to-string body)) + (stall-seconds 30) + (s (dex:post url :headers req-headers :content body-json + :connect-timeout (min 5 timeout) + :read-timeout stall-seconds + :want-stream t))) + ;; v0.7.1: track stall timer — reset on each successful chunk + (let ((last-chunk-time (get-universal-time))) + (loop for raw = (handler-case (read-line s nil nil) + (error (c) + (declare (ignore c)) + nil)) + while raw + do (when *stream-cancel* ; v0.7.1: cancel check + (setf *stream-cancel* nil) + (funcall callback " [cancelled]") + (return)) + (let ((parsed (parse-sse-line raw))) + (cond + ((null parsed)) + ((eq parsed :done) (return)) + (t (handler-case + (let* ((json (cl-json:decode-json-from-string parsed)) + (choices (cdr (assoc :choices json))) + (choice (car choices)) + (delta (cdr (assoc :delta choice))) + (content (cdr (assoc :content delta)))) + (when content + (funcall callback content) + (setf last-chunk-time (get-universal-time)))) + (error ()))))) + (when (> (- (get-universal-time) last-chunk-time) stall-seconds) + (funcall callback "[Response stalled — timed out at 30s]") + (return)))) + (funcall callback "") + (close s) + (list :status :success)) + (error (c) + (list :status :error :message (format nil "~a Stream Failure: ~a" provider c))))))) + (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) @@ -165,3 +270,31 @@ If API-KEY is nil, reads from environment." "Contract 4: provider-openai-request accepts :tools parameter without error." (let ((result (provider-openai-request "test" "system" :tools (list)))) (fiveam:is (member (getf result :status) '(:success :error))))) + +;; ── v0.7.1 Streaming ── + +(fiveam:test test-parse-sse-line-data + "Contract 6: parse-sse-line extracts content from data: lines." + (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world"))) + (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}")))) + +(fiveam:test test-parse-sse-line-done + "Contract 6: parse-sse-line returns :done for [DONE]." + (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]")))) + +(fiveam:test test-parse-sse-line-nil + "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines." + (fiveam:is (null (passepartout::parse-sse-line ""))) + (fiveam:is (null (passepartout::parse-sse-line ":ok"))) + (fiveam:is (null (passepartout::parse-sse-line "event: ping")))) + +(fiveam:test test-provider-openai-stream-calls-callback + "Contract 5: provider-openai-stream calls callback with deltas and final empty string." + (let ((collected '())) + (flet ((collector (text) (push text collected))) + (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter)) + (let* ((reversed (nreverse collected)) + (last (car (last reversed)))) + (fiveam:is (stringp last)) + (fiveam:is (string= "" last)) + (fiveam:is (>= (length reversed) 2))))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 9f3f338..b07d0cc 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -45,7 +45,50 @@ Event handlers + daemon I/O + main loop. (or name raw)) raw))) (cond - ;; v0.7.0: Ctrl key bindings + ;; v0.7.1: Esc — interrupt streaming + ((and (eql ch 27) (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))) + ;; v0.7.1: Tab on empty input — extract then open URL from agent message + ((and (or (eql ch 9) (eq ch :tab)) + (null (st :input-buffer))) + (if (st :url-buffer) + ;; Already extracted — now open it + (progn + (add-msg :system (format nil "Opening ~a" (st :url-buffer))) + (setf (st :url-buffer) nil)) + ;; Extract URL from last agent message + (let ((url nil)) + (loop for i from (1- (length (st :messages))) downto 0 + for msg = (aref (st :messages) i) + for content = (getf msg :content) + for role = (getf msg :role) + while (eq role :agent) + 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 #\)))) + content :start pos) + (length content)))) + (setf url (subseq content pos end)) + (return))))) + (if url + (progn + (setf (st :url-buffer) url) + (add-msg :system (format nil "Press Tab to open ~a" url)) + (setf (st :dirty) (list t t nil))) + nil)))) + ;; v0.7.0: Ctrl key bindings ((eql ch 21) ; Ctrl+U — clear line (setf (st :input-buffer) nil) (setf (st :dirty) (list nil nil t))) @@ -105,15 +148,14 @@ Event handlers + daemon I/O + main loop. (add-msg :system "\\ + Enter Multi-line input")) ;; /theme command - ((string-equal text "/theme") - (add-msg :system - (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" - *tui-theme-current-name* - (getf *tui-theme* :user) - (getf *tui-theme* :agent) - (getf *tui-theme* :system) - (getf *tui-theme* :input)) - (format nil "Presets: /theme dark | light | solarized | gruvbox"))) + ((string-equal text "/theme") + (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" + *tui-theme-current-name* + (getf *tui-theme* :user) + (getf *tui-theme* :agent) + (getf *tui-theme* :system) + (getf *tui-theme* :input))) + (add-msg :system "Presets: /theme dark | light | solarized | gruvbox")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme ")) (let ((name (string-trim '(#\Space) (subseq text 7)))) @@ -295,10 +337,42 @@ Event handlers + daemon I/O + main loop. (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) + (msg-type (getf msg :type)) (action (getf payload :action)) (gate-trace (getf msg :gate-trace)) (rule-count (getf payload :rule-count)) (foveal-id (getf payload :foveal-id))) + ;; v0.7.1: streaming chunk + (when (eq msg-type :stream-chunk) + (cond + ((string= text "") + ;; Final chunk: stamp time, clear streaming + (when (> (length (st :messages)) 0) + (let ((idx (1- (length (st :messages))))) + (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 nil t nil)) + (return-from on-daemon-msg nil)) + ((null (st :streaming-text)) + ;; First chunk: add new streaming message + (setf (st :streaming-text) "") + (setf (st :busy) nil) + (add-msg :agent text) + (let ((idx (1- (length (st :messages))))) + (setf (getf (aref (st :messages) idx) :streaming) t)) + (setf (st :streaming-text) text) + (setf (st :dirty) (list nil t nil)) + (return-from on-daemon-msg nil)) + (t + ;; Subsequent chunk: append + (let* ((new-text (concatenate 'string (st :streaming-text) text)) + (idx (1- (length (st :messages))))) + (setf (st :streaming-text) new-text) + (setf (getf (aref (st :messages) idx) :content) new-text) + (setf (st :dirty) (list nil t nil))) + (return-from on-daemon-msg nil)))) (when rule-count (setf (st :rule-count) rule-count)) (when foveal-id (setf (st :foveal-id) foveal-id)) (cond @@ -490,7 +564,7 @@ Event handlers + daemon I/O + main loop. (fiveam:is (eq :chat (st :mode))) (fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :stream))) - (fiveam:is (eq nil (st :messages))) + (fiveam:is (zerop (length (st :messages)))) (fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq nil (st :busy)))) @@ -499,7 +573,7 @@ Event handlers + daemon I/O + main loop. (init-state) (add-msg :user "hello") (let* ((msgs (st :messages)) - (msg (first msgs))) + (msg (aref msgs 0))) (fiveam:is (eq :user (getf msg :role))) (fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (stringp (getf msg :time))) @@ -540,7 +614,7 @@ Event handlers + daemon I/O + main loop. ;; A user message should be in the message list (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) - (let ((last (first msgs))) + (let ((last (aref msgs 0))) (fiveam:is (eq :user (getf last :role))) (fiveam:is (string= "test" (getf last :content)))))) @@ -553,7 +627,7 @@ Event handlers + daemon I/O + main loop. (on-key 343) (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) - (let ((last-msg (first msgs))) + (let ((last-msg (aref msgs 0))) (fiveam:is (eq :system (getf last-msg :role))) (fiveam:is (search "=> 3" (getf last-msg :content)))))) @@ -573,7 +647,7 @@ Event handlers + daemon I/O + main loop. (dolist (ch (coerce "/focus myapp" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-scope-command @@ -582,7 +656,7 @@ Event handlers + daemon I/O + main loop. (dolist (ch (coerce "/scope memex" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-unfocus-command @@ -591,7 +665,7 @@ Event handlers + daemon I/O + main loop. (dolist (ch (coerce "/unfocus" 'list)) (on-key (char-code ch))) (on-key 343) - (let ((msg (first (st :messages)))) + (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-tab-completion @@ -683,4 +757,54 @@ Event handlers + daemon I/O + main loop. (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch))) (on-key 9) (fiveam:is (search "dark" (input-string) :test #'char-equal))) + +;; ── v0.7.1 Streaming ── + +(fiveam:test test-stream-chunk-appends + "Contract/v0.7.1: stream-chunk frame appends to last message." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello"))) + (on-daemon-msg '(:type :stream-chunk :payload (:text " world"))) + (let ((msgs (st :messages))) + (fiveam:is (= 1 (length msgs))) + (let ((msg (aref msgs 0))) + (fiveam:is (eq :agent (getf msg :role))) + (fiveam:is (string= "Hello world" (getf msg :content))) + (fiveam:is (eq t (getf msg :streaming)))))) + +(fiveam:test test-stream-chunk-final + "Contract/v0.7.1: final empty chunk stamps timestamp and clears streaming flag." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi"))) + (on-daemon-msg '(:type :stream-chunk :payload (:text ""))) + (let ((msg (aref (st :messages) 0))) + (fiveam:is (stringp (getf msg :time))) + (fiveam:is (string= "Hi" (getf msg :content))) + (fiveam:is (null (st :streaming-text))))) + +(fiveam:test test-stream-interrupt + "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes." + (init-state) + (on-daemon-msg '(:type :stream-chunk :payload (:text "partial"))) + (on-key 27) + (let ((msg (aref (st :messages) 0))) + (fiveam:is (stringp (getf msg :time))) + (fiveam:is (search "[interrupted]" (getf msg :content))) + (fiveam:is (null (st :streaming-text))) + (fiveam:is (null (st :busy))))) + +(fiveam:test test-stream-check-skip + "Contract/v0.7.1: Esc without active streaming does nothing." + (init-state) + (on-key 27) + (fiveam:is (null (st :streaming-text))) + (fiveam:is (= 0 (length (st :messages))))) + +(fiveam:test test-tab-open-url + "Contract/v0.7.1: Tab on empty input with URL message extracts URL." + (init-state) + (add-msg :agent "visit https://example.com for info") + ;; Tab should extract URL and set url buffer (model-level test) + (on-key 9) + (fiveam:is (string= "https://example.com" (st :url-buffer)))) #+end_src diff --git a/org/channel-tui-state.org b/org/channel-tui-state.org index d8498ba..061807a 100644 --- a/org/channel-tui-state.org +++ b/org/channel-tui-state.org @@ -134,6 +134,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") :scroll-offset 0 :busy nil :cursor-pos 0 :pending-ctrl-x nil :scroll-at-bottom t :scroll-notify nil + :streaming-text nil :url-buffer nil ; v0.7.1 :dirty (list nil nil nil)))) #+end_src diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index c37ea00..98acd18 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -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 diff --git a/org/core-reason.org b/org/core-reason.org index f02415a..43eac93 100644 --- a/org/core-reason.org +++ b/org/core-reason.org @@ -231,6 +231,7 @@ each cascade call via ~cost-track-backend-call~. All four calls are (let* ((sensor (proto-get (proto-get context :payload) :sensor)) (active-skill (find-triggered-skill context)) (tool-belt (generate-tool-belt-prompt)) + (reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming (global-context (if (fboundp 'context-assemble-cached) (context-assemble-cached context sensor) (if (fboundp 'context-assemble-global-awareness) @@ -283,9 +284,20 @@ each cascade call via ~cost-track-backend-call~. All four calls are (concatenate 'string (string #\Newline) standing-mandates-text) "") tool-belt (or global-context "") system-logs)))) - (let* ((thought (backend-cascade-call raw-prompt - :system-prompt system-prompt - :context context)) + (let* ((thought (if (and reply-stream (fboundp 'cascade-stream)) ; v0.7.1: streaming + (let ((acc (make-string-output-stream))) + (funcall 'cascade-stream raw-prompt system-prompt + (lambda (delta) + (when reply-stream + (format reply-stream "~a" + (frame-message (list :type :stream-chunk + :payload (list :text delta)))) + (finish-output reply-stream)) + (write-string delta acc))) + (get-output-stream-string acc)) + (backend-cascade-call raw-prompt + :system-prompt system-prompt + :context context))) (tool-calls (and (listp thought) (getf thought :tool-calls)))) ;; v0.5.0: cost tracking after successful cascade (when (and (fboundp 'cost-track-backend-call) diff --git a/org/core-transport.org b/org/core-transport.org index 2d7ddd8..537c0d3 100644 --- a/org/core-transport.org +++ b/org/core-transport.org @@ -151,7 +151,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.5.0"))) + (format stream "~a" (frame-message (make-hello-message "0.7.1"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/org/neuro-provider.org b/org/neuro-provider.org index 96bf579..3ed2be9 100644 --- a/org/neuro-provider.org +++ b/org/neuro-provider.org @@ -31,6 +31,18 @@ Providers register themselves at boot. No API key? That provider doesn't registe when the LLM returns a tool call, or the existing ~:content~ path otherwise. 4. (provider-cascade-initialize): reads ~PROVIDER_CASCADE~ from env and sets ~*provider-cascade*~. +5. (provider-openai-stream prompt system-prompt callback &key model provider tools): + v0.7.1 — executes a streaming OpenAI-compatible /v1/chat/completions + request. Sends ~"stream": true~ in the request body. Reads Server-Sent + Events (SSE) from the response stream, parsing ~data: ...~ lines. For + each delta with content, calls CALLBACK with the delta string. After + all deltas, calls CALLBACK with ~""~ to signal end-of-stream. Returns + ~(:status :success)~ on completion or ~(:status :error :message ...)~. + If ~*stream-cancel*~ is set to T (by another thread), exits the SSE + loop and calls CALLBACK with ~""~. +6. (parse-sse-line line): parses an SSE line. Returns the data content + for ~data: ~ lines, ~:done~ for ~data: [DONE]~, and ~nil~ + for comment lines (starting with ~:~), empty lines, or non-data lines. * Implementation @@ -202,6 +214,142 @@ If API-KEY is nil, reads from environment." :trigger (lambda (ctx) (declare (ignore ctx)) nil)) #+end_src +* v0.7.1 — Streaming Backend +:PROPERTIES: +:ID: id-v071-streaming +:CREATED: [2026-05-08 Fri] +:END: + +** SSE Parser + +*** RED +#+begin_example +test-parse-sse-line-data: 0/2 pass — stub returns nil instead of content +test-parse-sse-line-done: 0/1 pass — stub returns nil instead of :done +test-parse-sse-line-nil: 3/3 pass — stub correctly returns nil +#+end_example + +*** GREEN +#+begin_example +test-parse-sse-line-data: 2/2 pass (100%) +test-parse-sse-line-done: 1/1 pass (100%) +test-parse-sse-line-nil: 3/3 pass (100%) +test-provider-openai-stream-calls-callback: 3/3 pass (100%) +llm-gateway-suite: 13/13 pass (100%) +#+end_example + +** Cascade Stream +#+begin_src lisp +(defun cascade-stream (prompt system-prompt callback) + "Streaming cascade: calls provider-openai-stream on the first available backend. +Calls CALLBACK with each delta string, then with '' to signal end-of-stream." + (dolist (backend *provider-cascade*) + (when (gethash backend *probabilistic-backends*) + (let ((result (provider-openai-stream prompt system-prompt callback + :provider backend))) + (when (eq (getf result :status) :success) + (return cascade-stream)))))) +#+end_src +#+begin_src lisp +(in-package :passepartout) + +(defun parse-sse-line (line) + "Parse an SSE line. Returns data string, :done for [DONE], nil otherwise." + (cond + ((or (null line) (string= line "")) nil) + ((char= (char line 0) #\:) nil) + ((and (>= (length line) 6) (string-equal (subseq line 0 6) "data: ")) + (let ((content (subseq line 6))) + (if (string= content "[DONE]") + :done + content))) + (t nil))) +#+end_src + +** Streaming request +#+begin_src lisp +(defvar *stream-cancel* nil + "When T, the streaming SSE loop exits early.") + +(defun provider-openai-stream (prompt system-prompt callback &key model (provider :openrouter) tools) + "Streaming OpenAI-compatible request. Calls CALLBACK with each delta, then ''." + (let* ((config (provider-config provider)) + (base-url (getf config :base-url)) + (key-env (getf config :key-env)) + (url-env (getf config :url-env)) + (default-model (getf config :default-model)) + (api-key (when key-env (uiop:getenv key-env))) + (model-id (or model default-model)) + (url (if url-env + (let ((host (uiop:getenv url-env))) + (if host + (format nil "http://~a/v1/chat/completions" host) + (format nil "~a/chat/completions" base-url))) + (format nil "~a/chat/completions" base-url))) + (timeout (or (ignore-errors (parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT"))) 30)) + (req-headers (list (cons "Content-Type" "application/json"))) + (base `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) ))) + (stream . t)))) + (when api-key + (push (cons "Authorization" (format nil "Bearer ~a" api-key)) req-headers)) + (when (eq provider :openrouter) + (setf req-headers + (append req-headers + `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout") + ("X-Title" . "Passepartout"))))) + (let ((body (if tools + (append base + `((tools . ,(loop for tool in tools + collect (list (cons :|type| "function") + (cons :|function| + (loop for (k v) on tool by #'cddr + collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) + (:|tool_choice| . "auto"))) + base))) + (handler-case + (let* ((body-json (cl-json:encode-json-to-string body)) + (stall-seconds 30) + (s (dex:post url :headers req-headers :content body-json + :connect-timeout (min 5 timeout) + :read-timeout stall-seconds + :want-stream t))) + ;; v0.7.1: track stall timer — reset on each successful chunk + (let ((last-chunk-time (get-universal-time))) + (loop for raw = (handler-case (read-line s nil nil) + (error (c) + (declare (ignore c)) + nil)) + while raw + do (when *stream-cancel* ; v0.7.1: cancel check + (setf *stream-cancel* nil) + (funcall callback " [cancelled]") + (return)) + (let ((parsed (parse-sse-line raw))) + (cond + ((null parsed)) + ((eq parsed :done) (return)) + (t (handler-case + (let* ((json (cl-json:decode-json-from-string parsed)) + (choices (cdr (assoc :choices json))) + (choice (car choices)) + (delta (cdr (assoc :delta choice))) + (content (cdr (assoc :content delta)))) + (when content + (funcall callback content) + (setf last-chunk-time (get-universal-time)))) + (error ()))))) + (when (> (- (get-universal-time) last-chunk-time) stall-seconds) + (funcall callback "[Response stalled — timed out at 30s]") + (return)))) + (funcall callback "") + (close s) + (list :status :success)) + (error (c) + (list :status :error :message (format nil "~a Stream Failure: ~a" provider c))))))) +#+end_src + * Test Suite #+begin_src lisp (eval-when (:compile-toplevel :load-toplevel :execute) @@ -231,4 +379,32 @@ If API-KEY is nil, reads from environment." "Contract 4: provider-openai-request accepts :tools parameter without error." (let ((result (provider-openai-request "test" "system" :tools (list)))) (fiveam:is (member (getf result :status) '(:success :error))))) + +;; ── v0.7.1 Streaming ── + +(fiveam:test test-parse-sse-line-data + "Contract 6: parse-sse-line extracts content from data: lines." + (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world"))) + (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}")))) + +(fiveam:test test-parse-sse-line-done + "Contract 6: parse-sse-line returns :done for [DONE]." + (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]")))) + +(fiveam:test test-parse-sse-line-nil + "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines." + (fiveam:is (null (passepartout::parse-sse-line ""))) + (fiveam:is (null (passepartout::parse-sse-line ":ok"))) + (fiveam:is (null (passepartout::parse-sse-line "event: ping")))) + +(fiveam:test test-provider-openai-stream-calls-callback + "Contract 5: provider-openai-stream calls callback with deltas and final empty string." + (let ((collected '())) + (flet ((collector (text) (push text collected))) + (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter)) + (let* ((reversed (nreverse collected)) + (last (car (last reversed)))) + (fiveam:is (stringp last)) + (fiveam:is (string= "" last)) + (fiveam:is (>= (length reversed) 2))))) #+end_src