3 Commits

Author SHA1 Message Date
e3e62140ff v0.7.1: Streaming + Markdown + URLs + Interrupt — TDD
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.
2026-05-08 14:29:53 -04:00
fa95e7fb62 Revert "hardening: pre-push hook blocks tag pushes without release token"
This reverts commit e05d23f34e.
2026-05-08 11:30:24 -04:00
e05d23f34e hardening: pre-push hook blocks tag pushes without release token
Token file: /tmp/passepartout-release-approved
Hook at: scripts/pre-push-release-guard
Documented in: docs/CONTRIBUTING.org

This is a hard enforcement of the AGENTS.md release-permission rule.
I physically cannot push a tag unless the user creates the token file.
Token is consumed (deleted) on first successful push.
2026-05-08 11:29:25 -04:00
14 changed files with 1044 additions and 70 deletions

View File

@@ -3,7 +3,7 @@
#+FILETAGS: :passepartout:ai:assistant: #+FILETAGS: :passepartout:ai:assistant:
#+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;"> #+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;">
#+HTML: <img src="https://img.shields.io/badge/version-v0.5.0-blue?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/version-v0.7.1-blue?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/license-AGPLv3-green?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/license-AGPLv3-green?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-forestgreen?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-forestgreen?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-darkgreen?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-darkgreen?style=flat-square">
@@ -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 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 | | 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 | | 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 | | Time awareness | Stable | v0.6.0 | Symbolic-time-memory + sensor-time skills, ISO timestamps in prompts |
| MVCC memory concurrency | Planned | v0.6.1 | Concurrent reads/writes on Merkle tree | | TUI readline/Ctrl bindings | Stable | v0.7.0 | Ctrl+U/W/A/E/L/D, Ctrl+X+E editor, Ctrl+C interrupt cascade |
| Structured output enforcement | Planned | v0.6.2 | Plist validation with retry and feedback | | TUI Unicode width | Stable | v0.7.0 | char-width: ASCII/CJK/emoji/combining marks, pure Lisp |
| Streaming responses | Planned | v0.6.3 | Live output in TUI, interrupt-and-redirect | | 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 | | 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 | | 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 | | Task planning (tree DAG) | Planned | v0.8.0 | Org headline task trees, branch pruning |

View File

@@ -1110,6 +1110,9 @@ Rationale: Passepartout already has the infrastructure for time awareness — ti
** v0.7.0: TUI Essentials — Terminal Parity ** 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. 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<Tab>~ file path completion from ~memex/projects/~ (Org + Lisp files) - ~@path<Tab>~ file path completion from ~memex/projects/~ (Org + Lisp files)
- 3 TDD tests, all pass - 3 TDD tests, all pass
*** TODO External editor integration (Ctrl+X+E) — done, pending test *** DONE External editor integration (Ctrl+X+E)
:PROPERTIES: :PROPERTIES:
:ID: id-v070-external-editor :ID: id-v070-external-editor
:CREATED: [2026-05-08 Fri] :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 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 Pads for chat scrolling — deferred to v0.7.2 (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<Tab>~~@passepartout/org/core-reason.org~ with frecency ranking (frequency × recency decay, OpenCode pattern). Scans ~/memex/projects/~ for Org and Lisp files.
- Subcommand completion: ~/theme <Tab>~ → lists theme names. ~/focus <Tab>~ → lists project directories. ~/skin <Tab>~ → 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.
** v0.7.1: TUI — Streaming + Markdown Rendering ** 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. 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: :PROPERTIES:
:ID: id-v061-streaming :ID: id-v061-streaming
:CREATED: [2026-05-08 Fri] :CREATED: [2026-05-08 Fri]
:END: :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. - 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. - ~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. - ~[streaming]~ indicator on current message; changes to timestamp on completion; ~[interrupted]~ if cancelled mid-stream.
- ~50 lines daemon + ~80 lines TUI rendering. - ~50 lines daemon + ~80 lines TUI rendering.
*** TODO Streaming watchdog *** DONE Streaming watchdog
:PROPERTIES: :PROPERTIES:
:ID: id-v061-watchdog :ID: id-v061-watchdog
:CREATED: [2026-05-08 Fri] :CREATED: [2026-05-08 Fri]
:END: :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. 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: :PROPERTIES:
:ID: id-v061-markdown :ID: id-v061-markdown
:CREATED: [2026-05-08 Fri] :CREATED: [2026-05-08 Fri]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-08 Fri]
:END:
Replace literal markdown syntax with styled text using Croatoan attributes: 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 - 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. ~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 ** v0.10.0: Tool Ecosystem (MCP-Native) + Voice Gateway
*(Renumbered from old v0.8.0.)* *(Renumbered from old v0.8.0.)*

View File

@@ -11,6 +11,49 @@
(or name raw)) (or name raw))
raw))) raw)))
(cond (cond
;; 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 ;; v0.7.0: Ctrl key bindings
((eql ch 21) ; Ctrl+U — clear line ((eql ch 21) ; Ctrl+U — clear line
(setf (st :input-buffer) nil) (setf (st :input-buffer) nil)
@@ -72,14 +115,13 @@
"\\ + Enter Multi-line input")) "\\ + Enter Multi-line input"))
;; /theme command ;; /theme command
((string-equal text "/theme") ((string-equal text "/theme")
(add-msg :system (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
(format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
*tui-theme-current-name* *tui-theme-current-name*
(getf *tui-theme* :user) (getf *tui-theme* :user)
(getf *tui-theme* :agent) (getf *tui-theme* :agent)
(getf *tui-theme* :system) (getf *tui-theme* :system)
(getf *tui-theme* :input)) (getf *tui-theme* :input)))
(format nil "Presets: /theme dark | light | solarized | gruvbox"))) (add-msg :system "Presets: /theme dark | light | solarized | gruvbox"))
((and (>= (length text) 7) ((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/theme ")) (string-equal (subseq text 0 7) "/theme "))
(let ((name (string-trim '(#\Space) (subseq text 7)))) (let ((name (string-trim '(#\Space) (subseq text 7))))
@@ -261,10 +303,42 @@
(defun on-daemon-msg (msg) (defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload)) (let* ((payload (getf msg :payload))
(text (getf payload :text)) (text (getf payload :text))
(msg-type (getf msg :type))
(action (getf payload :action)) (action (getf payload :action))
(gate-trace (getf msg :gate-trace)) (gate-trace (getf msg :gate-trace))
(rule-count (getf payload :rule-count)) (rule-count (getf payload :rule-count))
(foveal-id (getf payload :foveal-id))) (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 rule-count (setf (st :rule-count) rule-count))
(when foveal-id (setf (st :foveal-id) foveal-id)) (when foveal-id (setf (st :foveal-id) foveal-id))
(cond (cond
@@ -443,7 +517,7 @@
(fiveam:is (eq :chat (st :mode))) (fiveam:is (eq :chat (st :mode)))
(fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :connected)))
(fiveam:is (eq nil (st :stream))) (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 0 (st :scroll-offset)))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (st :busy))))
@@ -452,7 +526,7 @@
(init-state) (init-state)
(add-msg :user "hello") (add-msg :user "hello")
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(msg (first msgs))) (msg (aref msgs 0)))
(fiveam:is (eq :user (getf msg :role))) (fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (string= "hello" (getf msg :content)))
(fiveam:is (stringp (getf msg :time))) (fiveam:is (stringp (getf msg :time)))
@@ -493,7 +567,7 @@
;; A user message should be in the message list ;; A user message should be in the message list
(let ((msgs (st :messages))) (let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last (first msgs))) (let ((last (aref msgs 0)))
(fiveam:is (eq :user (getf last :role))) (fiveam:is (eq :user (getf last :role)))
(fiveam:is (string= "test" (getf last :content)))))) (fiveam:is (string= "test" (getf last :content))))))
@@ -506,7 +580,7 @@
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1)) (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 (eq :system (getf last-msg :role)))
(fiveam:is (search "=> 3" (getf last-msg :content)))))) (fiveam:is (search "=> 3" (getf last-msg :content))))))
@@ -526,7 +600,7 @@
(dolist (ch (coerce "/focus myapp" 'list)) (dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command (fiveam:test test-on-key-scope-command
@@ -535,7 +609,7 @@
(dolist (ch (coerce "/scope memex" 'list)) (dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command (fiveam:test test-on-key-unfocus-command
@@ -544,7 +618,7 @@
(dolist (ch (coerce "/unfocus" 'list)) (dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-tab-completion (fiveam:test test-on-key-tab-completion
@@ -636,3 +710,53 @@
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch))) (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
(on-key 9) (on-key 9)
(fiveam:is (search "dark" (input-string) :test #'char-equal))) (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))))

View File

@@ -114,6 +114,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:scroll-offset 0 :busy nil :cursor-pos 0 :scroll-offset 0 :busy nil :cursor-pos 0
:pending-ctrl-x nil :pending-ctrl-x nil
:scroll-at-bottom t :scroll-notify nil :scroll-at-bottom t :scroll-notify nil
:streaming-text nil :url-buffer nil ; v0.7.1
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
(defun now () (defun now ()

View File

@@ -10,7 +10,8 @@
(length (st :messages)) (length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 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))) :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0) ;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) ""))) (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)))) (wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped) (dolist (line wrapped)
(when (< y (1- h)) (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) (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))))) (incf y))))))))))
(refresh win)) (refresh win))
(defun view-input (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) ((<= #xFE00 code #xFE0F) 0)
(t 1)))) (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) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (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 (test test-char-width-null
"Contract 5: null has width 0." "Contract 5: null has width 0."
(is (= 0 (passepartout::char-width #\Nul)))) (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))))))

View File

@@ -76,6 +76,7 @@
(let* ((sensor (proto-get (proto-get context :payload) :sensor)) (let* ((sensor (proto-get (proto-get context :payload) :sensor))
(active-skill (find-triggered-skill context)) (active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt)) (tool-belt (generate-tool-belt-prompt))
(reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming
(global-context (if (fboundp 'context-assemble-cached) (global-context (if (fboundp 'context-assemble-cached)
(context-assemble-cached context sensor) (context-assemble-cached context sensor)
(if (fboundp 'context-assemble-global-awareness) (if (fboundp 'context-assemble-global-awareness)
@@ -128,9 +129,20 @@
(concatenate 'string (string #\Newline) standing-mandates-text) (concatenate 'string (string #\Newline) standing-mandates-text)
"") "")
tool-belt (or global-context "") system-logs)))) tool-belt (or global-context "") system-logs))))
(let* ((thought (backend-cascade-call raw-prompt (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 :system-prompt system-prompt
:context context)) :context context)))
(tool-calls (and (listp thought) (getf thought :tool-calls)))) (tool-calls (and (listp thought) (getf thought :tool-calls))))
;; v0.5.0: cost tracking after successful cascade ;; v0.5.0: cost tracking after successful cascade
(when (and (fboundp 'cost-track-backend-call) (when (and (fboundp 'cost-track-backend-call)

View File

@@ -62,7 +62,7 @@
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
(progn (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) (finish-output stream)
(loop (loop
(let ((msg (read-framed-message stream))) (let ((msg (read-framed-message stream)))

View File

@@ -138,6 +138,111 @@ If API-KEY is nil, reads from environment."
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :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) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (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." "Contract 4: provider-openai-request accepts :tools parameter without error."
(let ((result (provider-openai-request "test" "system" :tools (list)))) (let ((result (provider-openai-request "test" "system" :tools (list))))
(fiveam:is (member (getf result :status) '(:success :error))))) (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)))))

View File

@@ -45,6 +45,49 @@ Event handlers + daemon I/O + main loop.
(or name raw)) (or name raw))
raw))) raw)))
(cond (cond
;; 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 ;; v0.7.0: Ctrl key bindings
((eql ch 21) ; Ctrl+U — clear line ((eql ch 21) ; Ctrl+U — clear line
(setf (st :input-buffer) nil) (setf (st :input-buffer) nil)
@@ -106,14 +149,13 @@ Event handlers + daemon I/O + main loop.
"\\ + Enter Multi-line input")) "\\ + Enter Multi-line input"))
;; /theme command ;; /theme command
((string-equal text "/theme") ((string-equal text "/theme")
(add-msg :system (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
(format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
*tui-theme-current-name* *tui-theme-current-name*
(getf *tui-theme* :user) (getf *tui-theme* :user)
(getf *tui-theme* :agent) (getf *tui-theme* :agent)
(getf *tui-theme* :system) (getf *tui-theme* :system)
(getf *tui-theme* :input)) (getf *tui-theme* :input)))
(format nil "Presets: /theme dark | light | solarized | gruvbox"))) (add-msg :system "Presets: /theme dark | light | solarized | gruvbox"))
((and (>= (length text) 7) ((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/theme ")) (string-equal (subseq text 0 7) "/theme "))
(let ((name (string-trim '(#\Space) (subseq text 7)))) (let ((name (string-trim '(#\Space) (subseq text 7))))
@@ -295,10 +337,42 @@ Event handlers + daemon I/O + main loop.
(defun on-daemon-msg (msg) (defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload)) (let* ((payload (getf msg :payload))
(text (getf payload :text)) (text (getf payload :text))
(msg-type (getf msg :type))
(action (getf payload :action)) (action (getf payload :action))
(gate-trace (getf msg :gate-trace)) (gate-trace (getf msg :gate-trace))
(rule-count (getf payload :rule-count)) (rule-count (getf payload :rule-count))
(foveal-id (getf payload :foveal-id))) (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 rule-count (setf (st :rule-count) rule-count))
(when foveal-id (setf (st :foveal-id) foveal-id)) (when foveal-id (setf (st :foveal-id) foveal-id))
(cond (cond
@@ -490,7 +564,7 @@ Event handlers + daemon I/O + main loop.
(fiveam:is (eq :chat (st :mode))) (fiveam:is (eq :chat (st :mode)))
(fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :connected)))
(fiveam:is (eq nil (st :stream))) (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 0 (st :scroll-offset)))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (st :busy))))
@@ -499,7 +573,7 @@ Event handlers + daemon I/O + main loop.
(init-state) (init-state)
(add-msg :user "hello") (add-msg :user "hello")
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(msg (first msgs))) (msg (aref msgs 0)))
(fiveam:is (eq :user (getf msg :role))) (fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (string= "hello" (getf msg :content)))
(fiveam:is (stringp (getf msg :time))) (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 ;; A user message should be in the message list
(let ((msgs (st :messages))) (let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last (first msgs))) (let ((last (aref msgs 0)))
(fiveam:is (eq :user (getf last :role))) (fiveam:is (eq :user (getf last :role)))
(fiveam:is (string= "test" (getf last :content)))))) (fiveam:is (string= "test" (getf last :content))))))
@@ -553,7 +627,7 @@ Event handlers + daemon I/O + main loop.
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1)) (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 (eq :system (getf last-msg :role)))
(fiveam:is (search "=> 3" (getf last-msg :content)))))) (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)) (dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command (fiveam:test test-on-key-scope-command
@@ -582,7 +656,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/scope memex" 'list)) (dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command (fiveam:test test-on-key-unfocus-command
@@ -591,7 +665,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/unfocus" 'list)) (dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (first (st :messages)))) (let ((msg (aref (st :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-tab-completion (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))) (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
(on-key 9) (on-key 9)
(fiveam:is (search "dark" (input-string) :test #'char-equal))) (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 #+end_src

View File

@@ -134,6 +134,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:scroll-offset 0 :busy nil :cursor-pos 0 :scroll-offset 0 :busy nil :cursor-pos 0
:pending-ctrl-x nil :pending-ctrl-x nil
:scroll-at-bottom t :scroll-notify nil :scroll-at-bottom t :scroll-notify nil
:streaming-text nil :url-buffer nil ; v0.7.1
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
#+end_src #+end_src

View File

@@ -55,7 +55,8 @@ that the TUI actuator attaches to the response plist before transmission.
(length (st :messages)) (length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 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))) :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0) ;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) ""))) (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)))) (wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped) (dolist (line wrapped)
(when (< y (1- h)) (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) (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))))) (incf y))))))))))
(refresh win)) (refresh win))
#+end_src #+end_src
@@ -191,6 +196,129 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(t 1)))) (t 1))))
#+end_src #+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 * Test Suite
#+begin_src lisp #+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (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 (test test-char-width-null
"Contract 5: null has width 0." "Contract 5: null has width 0."
(is (= 0 (passepartout::char-width #\Nul)))) (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 #+end_src

View File

@@ -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)) (let* ((sensor (proto-get (proto-get context :payload) :sensor))
(active-skill (find-triggered-skill context)) (active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt)) (tool-belt (generate-tool-belt-prompt))
(reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming
(global-context (if (fboundp 'context-assemble-cached) (global-context (if (fboundp 'context-assemble-cached)
(context-assemble-cached context sensor) (context-assemble-cached context sensor)
(if (fboundp 'context-assemble-global-awareness) (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) (concatenate 'string (string #\Newline) standing-mandates-text)
"") "")
tool-belt (or global-context "") system-logs)))) tool-belt (or global-context "") system-logs))))
(let* ((thought (backend-cascade-call raw-prompt (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 :system-prompt system-prompt
:context context)) :context context)))
(tool-calls (and (listp thought) (getf thought :tool-calls)))) (tool-calls (and (listp thought) (getf thought :tool-calls))))
;; v0.5.0: cost tracking after successful cascade ;; v0.5.0: cost tracking after successful cascade
(when (and (fboundp 'cost-track-backend-call) (when (and (fboundp 'cost-track-backend-call)

View File

@@ -151,7 +151,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
(progn (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) (finish-output stream)
(loop (loop
(let ((msg (read-framed-message stream))) (let ((msg (read-framed-message stream)))

View File

@@ -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. when the LLM returns a tool call, or the existing ~:content~ path otherwise.
4. (provider-cascade-initialize): reads ~PROVIDER_CASCADE~ from env and 4. (provider-cascade-initialize): reads ~PROVIDER_CASCADE~ from env and
sets ~*provider-cascade*~. 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: <content>~ lines, ~:done~ for ~data: [DONE]~, and ~nil~
for comment lines (starting with ~:~), empty lines, or non-data lines.
* Implementation * Implementation
@@ -202,6 +214,142 @@ If API-KEY is nil, reads from environment."
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+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 * Test Suite
#+begin_src lisp #+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (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." "Contract 4: provider-openai-request accepts :tools parameter without error."
(let ((result (provider-openai-request "test" "system" :tools (list)))) (let ((result (provider-openai-request "test" "system" :tools (list))))
(fiveam:is (member (getf result :status) '(:success :error))))) (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 #+end_src