v0.7.0: scroll notify + autocomplete — TDD
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Scroll notification: :scroll-notify flag in add-msg when scrolled up. Autocomplete: @ file paths, /theme subcommand defaults, /focus dirs. 4 new TDD tests (6 assertions), 100% pass. Core: 135/135 (100%). Remaining deferred: scroll pads (needs Croatoan terminal), setup wizard (v0.8.0).
This commit is contained in:
@@ -1399,6 +1399,20 @@ The privacy tag filter (~dispatcher-check-privacy-tags~) is binary: a tag matche
|
||||
- Backward compatible: existing ~PRIVACY_FILTER_TAGS~ env var becomes the default ~:block~ tier entries
|
||||
~50 lines in ~security-dispatcher.lisp~ + ~20 lines TUI command.
|
||||
|
||||
*** TODO Merkle provenance audit — ~/audit <node-id>~
|
||||
:PROPERTIES:
|
||||
:ID: id-v062-audit
|
||||
:CREATED: [2026-05-08 Fri]
|
||||
:END:
|
||||
|
||||
Every Passepartout memory object has content-addressed identity via Merkle hashing (v0.2.0). No competitor has this — linear transcripts lose provenance on compaction. Expose it:
|
||||
|
||||
- ~/audit <node-id>~ — display full lineage: which session created this node, which tool modified it, which gate approved each modification, timestamps at each change
|
||||
- ~/audit <node-id> files~ — show which files were changed in the same turn as this node was created, with diff sizes
|
||||
- ~/audit verify~ — re-hash the entire Merkle tree and compare with stored root. "✓ 847 nodes verified, root hash matches." Catches silent corruption.
|
||||
- Provenance data is already in the Merkle tree's parent-child hash chain. This is a rendering exposure, not new data.
|
||||
~30 lines on existing Merkle infrastructure.
|
||||
|
||||
** v0.8.0: Direction 2 — Information Radiator (Foundation)
|
||||
|
||||
The sidebar is what makes the Information Radiator direction unique. No competitor can render gate traces, focus maps, or rule counters because none has deterministic gates, foveal-peripheral context, or rule synthesis. The sidebar makes this data permanently visible. It also includes context monitoring, modified files, and tool status — all zero-LLM-token data from the deterministic layer.
|
||||
|
||||
@@ -150,24 +150,57 @@
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :cursor-pos) 0)
|
||||
(setf (st :dirty) (list t t t))))))
|
||||
;; Tab — command completion
|
||||
;; Tab — command completion (v0.7.0: extended with subcommand + file paths)
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
(let ((text (input-string)))
|
||||
(cond
|
||||
((and (>= (length text) 8)
|
||||
(string-equal (subseq text 0 7) "/theme "))
|
||||
(let* ((partial (subseq text 7))
|
||||
;; @ prefix — file path completion
|
||||
((and (>= (length text) 1) (eql (char text 0) #\@))
|
||||
(let* ((partial (subseq text 1))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(files (handler-case (append (uiop:directory-files proj "**/*.org")
|
||||
(uiop:directory-files proj "**/*.lisp"))
|
||||
(error () nil)))
|
||||
(names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files))
|
||||
(match (find-if (lambda (n) (and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
names)))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /theme subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(names '("dark" "light" "solarized" "gruvbox"))
|
||||
(match (find partial names :test #'string-equal)))
|
||||
(match (if (string= partial "") (first names)
|
||||
(find partial names :test #'string-equal))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /focus subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d))))
|
||||
(uiop:subdirectories proj))
|
||||
(error () nil)))
|
||||
(match (if (string= partial "") (first dirs)
|
||||
(find-if (lambda (d) (and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; Command prefix /
|
||||
((and (> (length text) 1) (eql (char text 0) #\/))
|
||||
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
|
||||
(match (find text cmds :test
|
||||
(lambda (in cmd)
|
||||
(and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(lambda (in cmd) (and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce match 'list)))
|
||||
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
|
||||
@@ -586,3 +619,20 @@
|
||||
(let ((d (st :dirty)))
|
||||
(fiveam:is (eq t (first d)))
|
||||
(fiveam:is (eq t (second d)))))
|
||||
|
||||
(fiveam:test test-scroll-notify
|
||||
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
|
||||
(init-state)
|
||||
(setf (st :scroll-at-bottom) nil)
|
||||
(add-msg :agent "hi")
|
||||
(fiveam:is (eq t (st :scroll-notify)))
|
||||
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil)
|
||||
(add-msg :agent "hi2")
|
||||
(fiveam:is (eq nil (st :scroll-notify))))
|
||||
|
||||
(fiveam:test test-tab-subcommand
|
||||
"Contract/v0.7.0: Tab completes subcommand for /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
|
||||
(on-key 9)
|
||||
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
|
||||
|
||||
@@ -113,6 +113,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:pending-ctrl-x nil
|
||||
:scroll-at-bottom t :scroll-notify nil
|
||||
:dirty (list nil nil nil))))
|
||||
|
||||
(defun now ()
|
||||
@@ -144,6 +145,9 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
;; v0.7.0: notify when scrolled up and new msg arrives
|
||||
(unless (st :scroll-at-bottom)
|
||||
(setf (st :scroll-notify) t))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
|
||||
(defun queue-event (ev)
|
||||
|
||||
@@ -184,24 +184,57 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :cursor-pos) 0)
|
||||
(setf (st :dirty) (list t t t))))))
|
||||
;; Tab — command completion
|
||||
;; Tab — command completion (v0.7.0: extended with subcommand + file paths)
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
(let ((text (input-string)))
|
||||
(cond
|
||||
((and (>= (length text) 8)
|
||||
(string-equal (subseq text 0 7) "/theme "))
|
||||
(let* ((partial (subseq text 7))
|
||||
;; @ prefix — file path completion
|
||||
((and (>= (length text) 1) (eql (char text 0) #\@))
|
||||
(let* ((partial (subseq text 1))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(files (handler-case (append (uiop:directory-files proj "**/*.org")
|
||||
(uiop:directory-files proj "**/*.lisp"))
|
||||
(error () nil)))
|
||||
(names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files))
|
||||
(match (find-if (lambda (n) (and (>= (length n) (length partial))
|
||||
(string-equal n partial :end2 (length partial))))
|
||||
names)))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /theme subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(names '("dark" "light" "solarized" "gruvbox"))
|
||||
(match (find partial names :test #'string-equal)))
|
||||
(match (if (string= partial "") (first names)
|
||||
(find partial names :test #'string-equal))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; /focus subcommand
|
||||
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
|
||||
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
|
||||
(memex (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex))
|
||||
(dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d))))
|
||||
(uiop:subdirectories proj))
|
||||
(error () nil)))
|
||||
(match (if (string= partial "") (first dirs)
|
||||
(find-if (lambda (d) (and (>= (length d) (length partial))
|
||||
(string-equal d partial :end2 (length partial))))
|
||||
dirs))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; Command prefix /
|
||||
((and (> (length text) 1) (eql (char text 0) #\/))
|
||||
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
|
||||
(match (find text cmds :test
|
||||
(lambda (in cmd)
|
||||
(and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(lambda (in cmd) (and (>= (length cmd) (length in))
|
||||
(string-equal cmd in :end1 (length in)))))))
|
||||
(when match
|
||||
(setf (st :input-buffer) (reverse (coerce match 'list)))
|
||||
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
|
||||
@@ -633,4 +666,21 @@ Event handlers + daemon I/O + main loop.
|
||||
(let ((d (st :dirty)))
|
||||
(fiveam:is (eq t (first d)))
|
||||
(fiveam:is (eq t (second d)))))
|
||||
|
||||
(fiveam:test test-scroll-notify
|
||||
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
|
||||
(init-state)
|
||||
(setf (st :scroll-at-bottom) nil)
|
||||
(add-msg :agent "hi")
|
||||
(fiveam:is (eq t (st :scroll-notify)))
|
||||
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil)
|
||||
(add-msg :agent "hi2")
|
||||
(fiveam:is (eq nil (st :scroll-notify))))
|
||||
|
||||
(fiveam:test test-tab-subcommand
|
||||
"Contract/v0.7.0: Tab completes subcommand for /theme."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
|
||||
(on-key 9)
|
||||
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
|
||||
#+end_src
|
||||
|
||||
@@ -133,6 +133,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:pending-ctrl-x nil
|
||||
:scroll-at-bottom t :scroll-notify nil
|
||||
:dirty (list nil nil nil))))
|
||||
#+end_src
|
||||
|
||||
@@ -167,6 +168,9 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
;; v0.7.0: notify when scrolled up and new msg arrives
|
||||
(unless (st :scroll-at-bottom)
|
||||
(setf (st :scroll-notify) t))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
#+end_src
|
||||
|
||||
|
||||
Reference in New Issue
Block a user