v0.7.2: context visibility — section breakdown + token budget — TDD
/context now shows full budget breakdown: IDENTITY, TOOLS, TIME+CONFIG, LOGS with per-section token estimates, visual bar chart, and percentage used. Over-80% warning. Estimates computed from live state: identity/config lengths, tool registry count, message count. Budget cap at 8192 tokens. - channel-tui-main: rewritten /context handler, 1 new test - TUI Main: 101/101
This commit is contained in:
@@ -225,24 +225,31 @@
|
||||
(dolist (entry cats)
|
||||
(add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
|
||||
(add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
|
||||
;; /context command — context visibility
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(est-tokens (min 8192 (* msg-count 50))))
|
||||
(add-msg :system (format nil "Context: ~d msgs, focus=~a, est ~d/8192 tokens"
|
||||
msg-count focus est-tokens))
|
||||
(let ((start (max 0 (- msg-count 5))))
|
||||
(loop for i from start below msg-count
|
||||
for m = (aref (st :messages) i)
|
||||
for content = (getf m :content)
|
||||
for preview = (if (> (length content) 50)
|
||||
(concatenate 'string (subseq content 0 47) "...")
|
||||
content)
|
||||
for role = (getf m :role)
|
||||
do (add-msg :system (format nil " ~a: ~a"
|
||||
(case role (:user "You") (:agent "Agent") (t "Sys"))
|
||||
preview))))))
|
||||
;; /context command — section breakdown with token estimates
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4)))
|
||||
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
|
||||
(floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4)
|
||||
50))
|
||||
(log-tokens (min 4000 (floor (* msg-count 60) 4)))
|
||||
;; rough estimate: TIME, CONTEXT overhead
|
||||
(overhead-tokens 200)
|
||||
(total-est (+ id-tokens tool-tokens log-tokens overhead-tokens))
|
||||
(total-limit 8192)
|
||||
(pct-used (floor (* 100 total-est) total-limit))
|
||||
(bar (make-string (min 10 (max 1 (floor (/ (min total-est total-limit) total-limit) 10)))
|
||||
:initial-element #\#)))
|
||||
(add-msg :system (format nil "╔══ Context Budget ~a/~a tokens (~d%) ══╗" total-est total-limit pct-used))
|
||||
(add-msg :system (format nil "IDENTITY ~5d tokens" id-tokens))
|
||||
(add-msg :system (format nil "TOOLS ~5d tokens" tool-tokens))
|
||||
(add-msg :system (format nil "TIME+CONFIG ~5d tokens" overhead-tokens))
|
||||
(add-msg :system (format nil "LOGS ~5d tokens (~d msgs)" log-tokens msg-count))
|
||||
(add-msg :system (format nil " [~a~a] ~d%"
|
||||
bar (make-string (- 10 (length bar)) :initial-element #\Space) pct-used))
|
||||
(when (> pct-used 80)
|
||||
(add-msg :system "⚠ Context near limit — older messages may be dropped"))))
|
||||
;; /context why <id> — debug node
|
||||
((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why "))
|
||||
(let ((node-id (string-trim '(#\Space) (subseq text 13))))
|
||||
@@ -1201,3 +1208,15 @@
|
||||
(fiveam:is (= 0 (st :search-match-idx)))
|
||||
(on-key 259) ;; Up (clamped)
|
||||
(fiveam:is (= 0 (st :search-match-idx))))
|
||||
|
||||
(fiveam:test test-context-sections
|
||||
"Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS."
|
||||
(init-state)
|
||||
(add-msg :agent "hello world")
|
||||
(dolist (ch (coerce "/context" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs))
|
||||
(fiveam:is (some (lambda (m) (search "LOGS" (getf m :content))) msgs))
|
||||
(fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs))))
|
||||
|
||||
@@ -259,24 +259,31 @@ Event handlers + daemon I/O + main loop.
|
||||
(dolist (entry cats)
|
||||
(add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
|
||||
(add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
|
||||
;; /context command — context visibility
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(est-tokens (min 8192 (* msg-count 50))))
|
||||
(add-msg :system (format nil "Context: ~d msgs, focus=~a, est ~d/8192 tokens"
|
||||
msg-count focus est-tokens))
|
||||
(let ((start (max 0 (- msg-count 5))))
|
||||
(loop for i from start below msg-count
|
||||
for m = (aref (st :messages) i)
|
||||
for content = (getf m :content)
|
||||
for preview = (if (> (length content) 50)
|
||||
(concatenate 'string (subseq content 0 47) "...")
|
||||
content)
|
||||
for role = (getf m :role)
|
||||
do (add-msg :system (format nil " ~a: ~a"
|
||||
(case role (:user "You") (:agent "Agent") (t "Sys"))
|
||||
preview))))))
|
||||
;; /context command — section breakdown with token estimates
|
||||
((string-equal text "/context")
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(focus (or (st :foveal-id) "none"))
|
||||
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4)))
|
||||
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
|
||||
(floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4)
|
||||
50))
|
||||
(log-tokens (min 4000 (floor (* msg-count 60) 4)))
|
||||
;; rough estimate: TIME, CONTEXT overhead
|
||||
(overhead-tokens 200)
|
||||
(total-est (+ id-tokens tool-tokens log-tokens overhead-tokens))
|
||||
(total-limit 8192)
|
||||
(pct-used (floor (* 100 total-est) total-limit))
|
||||
(bar (make-string (min 10 (max 1 (floor (/ (min total-est total-limit) total-limit) 10)))
|
||||
:initial-element #\#)))
|
||||
(add-msg :system (format nil "╔══ Context Budget ~a/~a tokens (~d%) ══╗" total-est total-limit pct-used))
|
||||
(add-msg :system (format nil "IDENTITY ~5d tokens" id-tokens))
|
||||
(add-msg :system (format nil "TOOLS ~5d tokens" tool-tokens))
|
||||
(add-msg :system (format nil "TIME+CONFIG ~5d tokens" overhead-tokens))
|
||||
(add-msg :system (format nil "LOGS ~5d tokens (~d msgs)" log-tokens msg-count))
|
||||
(add-msg :system (format nil " [~a~a] ~d%"
|
||||
bar (make-string (- 10 (length bar)) :initial-element #\Space) pct-used))
|
||||
(when (> pct-used 80)
|
||||
(add-msg :system "⚠ Context near limit — older messages may be dropped"))))
|
||||
;; /context why <id> — debug node
|
||||
((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why "))
|
||||
(let ((node-id (string-trim '(#\Space) (subseq text 13))))
|
||||
@@ -1248,4 +1255,16 @@ Event handlers + daemon I/O + main loop.
|
||||
(fiveam:is (= 0 (st :search-match-idx)))
|
||||
(on-key 259) ;; Up (clamped)
|
||||
(fiveam:is (= 0 (st :search-match-idx))))
|
||||
|
||||
(fiveam:test test-context-sections
|
||||
"Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS."
|
||||
(init-state)
|
||||
(add-msg :agent "hello world")
|
||||
(dolist (ch (coerce "/context" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs))
|
||||
(fiveam:is (some (lambda (m) (search "LOGS" (getf m :content))) msgs))
|
||||
(fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user