v0.8.3: TUI stabilization — box calls, package fixes, sandbox, configure
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
This commit is contained in:
@@ -325,7 +325,7 @@
|
||||
;; /tags command — tag stack
|
||||
;; /tags command — tag stack
|
||||
((string-equal text "/tags")
|
||||
(let ((cats passepartout::*tag-categories*))
|
||||
(let ((cats *tag-categories*))
|
||||
(if cats
|
||||
(dolist (entry cats)
|
||||
(add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
|
||||
@@ -335,8 +335,8 @@
|
||||
(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)
|
||||
(tool-tokens (if (boundp '*cognitive-tool-registry*)
|
||||
(floor (* (hash-table-count *cognitive-tool-registry*) 40) 4)
|
||||
50))
|
||||
(log-tokens (min 4000 (floor (* msg-count 60) 4)))
|
||||
(overhead-tokens 200)
|
||||
@@ -352,14 +352,14 @@
|
||||
;; /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))))
|
||||
(if (fboundp 'passepartout::memory-object-get)
|
||||
(let ((obj (funcall 'passepartout::memory-object-get node-id)))
|
||||
(if (fboundp 'memory-object-get)
|
||||
(let ((obj (funcall 'memory-object-get node-id)))
|
||||
(if obj
|
||||
(add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a"
|
||||
node-id
|
||||
(passepartout::memory-object-type obj)
|
||||
(passepartout::memory-object-scope obj)
|
||||
(passepartout::memory-object-version obj)))
|
||||
(memory-object-type obj)
|
||||
(memory-object-scope obj)
|
||||
(memory-object-version obj)))
|
||||
(add-msg :system (format nil "Node ~a not found" node-id))))
|
||||
(add-msg :system "Memory not available"))))
|
||||
;; /context dropped — pruned nodes
|
||||
@@ -391,18 +391,18 @@
|
||||
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
|
||||
(n (handler-case (parse-integer n-str) (error () nil))))
|
||||
(if n
|
||||
(if (fboundp 'passepartout::rollback-memory)
|
||||
(if (fboundp 'rollback-memory)
|
||||
(let* ((idx (1- n))
|
||||
(snaps passepartout::*memory-snapshots*)
|
||||
(snaps *memory-snapshots*)
|
||||
(ts (when (< idx (length snaps))
|
||||
(getf (nth idx snaps) :timestamp))))
|
||||
(funcall 'passepartout::rollback-memory idx)
|
||||
(funcall 'rollback-memory idx)
|
||||
(add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts)))
|
||||
(add-msg :system "Memory rollback not available"))
|
||||
(add-msg :system "Usage: /rewind <number>"))))
|
||||
;; /sessions command — list snapshots
|
||||
((string-equal text "/sessions")
|
||||
(let ((snaps passepartout::*memory-snapshots*))
|
||||
(let ((snaps *memory-snapshots*))
|
||||
(if snaps
|
||||
(let ((shown (subseq snaps 0 (min 10 (length snaps)))))
|
||||
(add-msg :system (format nil "~d snapshots (showing ~d):"
|
||||
@@ -421,19 +421,19 @@
|
||||
(maphash (lambda (k v) (declare (ignore k))
|
||||
(when v
|
||||
(incf count)
|
||||
(when (passepartout::memory-object-hash v)
|
||||
(when (memory-object-hash v)
|
||||
(incf hashed))))
|
||||
passepartout::*memory-store*)
|
||||
*memory-store*)
|
||||
(add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots"
|
||||
count hashed
|
||||
(length passepartout::*memory-snapshots*)))))
|
||||
(length *memory-snapshots*)))))
|
||||
;; /resume <n> — resume from snapshot
|
||||
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume "))
|
||||
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
|
||||
(n (handler-case (parse-integer n-str) (error () nil))))
|
||||
(if n
|
||||
(if (fboundp 'passepartout::rollback-memory)
|
||||
(progn (funcall 'passepartout::rollback-memory (1- n))
|
||||
(if (fboundp 'rollback-memory)
|
||||
(progn (funcall 'rollback-memory (1- n))
|
||||
(add-msg :system (format nil "Resumed from snapshot ~d" n)))
|
||||
(add-msg :system "Memory rollback not available"))
|
||||
(add-msg :system "Usage: /resume <number>"))))
|
||||
@@ -1083,23 +1083,20 @@
|
||||
(setf (st :stream) nil (st :connected) nil)
|
||||
(add-msg :system "* Disconnected *")))
|
||||
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
(theme-load)
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(sidebar-w (when (>= w 120)
|
||||
(make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44))))
|
||||
(content-w (if sidebar-w (- w 44) (- w 2)))
|
||||
(ch (- h 5))
|
||||
(sw (make-instance 'window :height 3 :width content-w :y 0 :x 1))
|
||||
(cw (make-instance 'window :height ch :width content-w :y 3 :x 1))
|
||||
(iw (make-instance 'window :height 1 :width content-w :y (- h 1) :x 1))
|
||||
(swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(defun tui-run-screen (scr)
|
||||
"The full TUI event loop. Called from tui-main inside with-screen."
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(sidebar-w (when (>= w 120)
|
||||
(make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44))))
|
||||
(content-w (if sidebar-w (- w 44) (- w 2)))
|
||||
(ch (- h 5))
|
||||
(sw (make-instance 'window :height 3 :width content-w :y 0 :x 1))
|
||||
(cw (make-instance 'window :height ch :width content-w :y 3 :x 1))
|
||||
(iw (make-instance 'window :height 1 :width content-w :y (- h 1) :x 1))
|
||||
(swank-port (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
|
||||
4006)))
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
@@ -1211,7 +1208,14 @@
|
||||
(close wizard-win)))
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
(disconnect-daemon)))))
|
||||
(disconnect-daemon))))
|
||||
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
(theme-load)
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(tui-run-screen scr)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
Reference in New Issue
Block a user