Compare commits
3 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| e3e62140ff | |||
| fa95e7fb62 | |||
| e05d23f34e |
15
README.org
15
README.org
@@ -3,7 +3,7 @@
|
||||
#+FILETAGS: :passepartout:ai:assistant:
|
||||
|
||||
#+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/Lisp-Common%20Lisp-forestgreen?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 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 |
|
||||
|
||||
@@ -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<Tab>~ 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<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.
|
||||
*** 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.)*
|
||||
|
||||
@@ -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))))
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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))))))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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)))))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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: <content>~ 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
|
||||
|
||||
Reference in New Issue
Block a user