diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index 6a1cc64..6144d60 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -1371,6 +1371,34 @@ The ~/context~ command (above) shows what the model sees. Add two deeper views: - Both views are read-only renderings of data already computed during ~context-awareness-assemble~. The similarity scores and depth classifications exist in memory — they're just never exposed. ~60 lines of rendering on existing data. +*** TODO Tool execution hardening — timeouts + write verification +:PROPERTIES: +:ID: id-v062-tool-hardening +:CREATED: [2026-05-08 Fri] +:END: + +Existing tools are thin wrappers with no error recovery. Claude Code has per-tool timeouts, write verification (read back after write), and output spilling. This hardens the tool execution layer — every tool is a Dispatcher gate surface, and brittle tools undermine trust. + +- ~*tool-timeouts*~ hash table: per-tool timeout in seconds (default 120s, configurable per tool). ~shell~ = 300s (builds take time), ~search-files~ = 30s (fast scans), ~eval-form~ = 10s (code should be quick). Enforced via ~with-timeout~ macro wrapping tool body execution. +- Write verification: after ~write-file~ or ~org-modify-file~, read back the written content and compare. On mismatch, log a warning and re-attempt once. Catches filesystem failures and partial writes. ~20 lines in ~programming-tools.lisp~ +- Read-only tool response caching: if the same tool with identical args is called twice in the same turn, return cached result instead of re-executing. ~15 lines. +~60 lines total. + +*** TODO Tag stack — categories + severity tiers +:PROPERTIES: +:ID: id-v062-tag-stack +:CREATED: [2026-05-08 Fri] +:END: + +The privacy tag filter (~dispatcher-check-privacy-tags~) is binary: a tag matches or it doesn't. This expands it into a layered system: + +- ~TAG_CATEGORIES~ env var with comma-separated tag→severity mappings: =@personal:block,@financial:block,@draft:warn,@review:warn= +- Three severity tiers: ~:block~ (always filter, never reach LLM), ~:warn~ (log a warning, include in gate trace, let through), ~:log~ (silently record, include in telemetry) +- User-defined tag categories beyond ~@personal~: financial, credential, health, draft, review, internal — any ~@tag~ prefix is recognized +- The ~/tags~ TUI command lists all defined tags, their severity, and how many times each was triggered this session +- Backward compatible: existing ~PRIVACY_FILTER_TAGS~ env var becomes the default ~:block~ tier entries +~50 lines in ~security-dispatcher.lisp~ + ~20 lines TUI command. + ** 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. diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index ec3342a..78100d7 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -11,41 +11,6 @@ (or name raw)) raw))) (cond - ;; v0.7.0: if pending Ctrl+X and key is not E, clear the prefix - ((and (st :pending-ctrl-x) (not (eql ch 5))) - (setf (st :pending-ctrl-x) nil) - ;; Fall through to normal handling below — re-process the key - (on-key ch)) - ;; v0.7.0: Ctrl+X prefix — next key determines chord - ((eql ch 24) ; Ctrl+X - (setf (st :pending-ctrl-x) t)) - ((and (eql ch 5) (st :pending-ctrl-x)) ; Ctrl+X+E — external editor - (setf (st :pending-ctrl-x) nil) - (add-msg :system "Opening external editor... Write your prompt, save, and exit.") - (setf (st :dirty) (list t t nil))) - ;; v0.7.0: Ctrl key bindings - ((eql ch 3) ; Ctrl+C — interrupt/abort/exit cascade - (add-msg :system "[Ctrl+C: send /abort to interrupt, press again to exit]")) - ((eql ch 12) ; Ctrl+L — clear/redraw screen - (add-msg :system "Screen redrawn") - (setf (st :dirty) (list t t t))) - ((eql ch 4) ; Ctrl+D — quit on empty input - (if (or (null (st :input-buffer)) (string= "" (input-string))) - (add-msg :system "Press /quit to exit. Goodbye!"))) - ((eql ch 21) ; Ctrl+U — clear line - (setf (st :input-buffer) nil) - (setf (st :dirty) (list nil nil t))) - ((eql ch 23) ; Ctrl+W — delete word backward - (let ((buf (or (st :input-buffer) nil))) - (when buf - (loop while (and buf (char= (first buf) #\Space)) do (pop buf)) - (loop while (and buf (char/= (first buf) #\Space)) do (pop buf)) - (setf (st :input-buffer) buf) - (setf (st :dirty) (list nil nil t))))) - ((eql ch 1) ; Ctrl+A — home - (setf (st :cursor-pos) 0)) - ((eql ch 5) ; Ctrl+E — end - (setf (st :cursor-pos) (length (st :input-buffer)))) ;; Enter ((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch #\Newline) (eql ch #\Return)) @@ -156,63 +121,18 @@ (setf (st :input-buffer) nil) (setf (st :cursor-pos) 0) (setf (st :dirty) (list t t t)))))) - ;; Tab — command completion (v0.7.0: extended with subcommand + file paths) + ;; Tab — command completion ((or (eql ch 9) (eq ch :tab)) (let ((text (input-string))) (cond - ;; @ prefix — file path completion from memex/projects - ((and (>= (length text) 1) (eql (char text 0) #\@)) - (let* ((partial (subseq text 1)) - (proj-dir (merge-pathnames - (make-pathname :directory '(:relative "projects")) - (or (uiop:getenv "MEMEX_DIR") - (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))) - (org-files (handler-case (uiop:directory-files proj-dir "**/*.org") - (error () nil))) - (lisp-files (handler-case (uiop:directory-files proj-dir "**/*.lisp") - (error () nil))) - (all-files (mapcar #'namestring (append org-files lisp-files))) - (short-names (mapcar (lambda (f) - (subseq f (1+ (length (namestring proj-dir))))) - all-files)) - (match (find-if (lambda (n) - (and (>= (length n) (length partial)) - (string-equal n partial :end2 (length partial)))) - short-names))) - (when match - (setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list))) - (setf (st :dirty) (list nil nil t))))) - ;; /theme subcommand completion - ((and (>= (length text) 7) + ((and (>= (length text) 8) (string-equal (subseq text 0 7) "/theme ")) - (let* ((partial (string-trim '(#\Space) (subseq text 7))) + (let* ((partial (subseq text 7)) (names '("dark" "light" "solarized" "gruvbox")) - (match (if (string= partial "") - (first names) - (find partial names :test #'string-equal)))) + (match (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 — project directory completion - ((and (>= (length text) 7) - (string-equal (subseq text 0 7) "/focus ")) - (let* ((partial (string-trim '(#\Space) (subseq text 7))) - (memex-dir (or (uiop:getenv "MEMEX_DIR") - (namestring (merge-pathnames "memex/" (user-homedir-pathname))))) - (proj-dir (merge-pathnames (make-pathname :directory '(:relative "projects")) memex-dir)) - (dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d)))) - (uiop:subdirectories proj-dir)) - (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 completion — /prefix ((and (> (length text) 1) (eql (char text 0) #\/)) (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit")) (match (find text cmds :test @@ -461,8 +381,7 @@ (fiveam:is (eq :chat (st :mode))) (fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :stream))) - (fiveam:is (vectorp (st :messages))) - (fiveam:is (= 0 (length (st :messages)))) + (fiveam:is (eq nil (st :messages))) (fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq nil (st :busy)))) @@ -622,97 +541,3 @@ (fiveam:is (eq :yellow (getf *tui-theme* :system))) (fiveam:is (eq :cyan (getf *tui-theme* :input))) (fiveam:is (eq :white (theme-color :unknown-role)))) - -(fiveam:test test-on-key-ctrl-d-empty-quits - "Contract 1/v0.7.0: Ctrl+D on empty input adds quit system message." - (init-state) - (on-key 4) ; Ctrl+D - (let ((msgs (st :messages))) - (fiveam:is (> (length msgs) 0)) ; at least one message - (fiveam:is (search "quit" (getf (elt msgs 0) :content) :test #'char-equal)))) - -(fiveam:test test-on-key-ctrl-u-clears-line - "Contract 1/v0.7.0: Ctrl+U clears the input buffer." - (init-state) - (dolist (ch '(#\h #\e #\l #\l #\o)) - (on-key (char-code ch))) - (on-key 21) ; Ctrl+U - (fiveam:is (string= "" (input-string)))) - -(fiveam:test test-on-key-ctrl-a-moves-home - "Contract 1/v0.7.0: Ctrl+A moves cursor to position 0." - (init-state) - (dolist (ch '(#\h #\i)) - (on-key (char-code ch))) - (on-key 1) ; Ctrl+A - (fiveam:is (= 0 (or (st :cursor-pos) 0)))) - -(fiveam:test test-on-key-ctrl-e-moves-end - "Contract 1/v0.7.0: Ctrl+E moves cursor to end of input." - (init-state) - (dolist (ch '(#\h #\i)) - (on-key (char-code ch))) - (on-key 5) ; Ctrl+E - (fiveam:is (= 2 (or (st :cursor-pos) 0)))) - -(fiveam:test test-on-key-ctrl-l-redraws - "Contract 1/v0.7.0: Ctrl+L sets all dirty flags for full redraw." - (init-state) - (setf (st :dirty) (list nil nil nil)) - (on-key 12) ; Ctrl+L - (let ((d (st :dirty))) - (fiveam:is (eq t (first d))) - (fiveam:is (eq t (second d))) - (fiveam:is (eq t (third d))))) - -(fiveam:test test-on-key-ctrl-x-e-editor - "Contract 1/v0.7.0: Ctrl+X then Ctrl+E triggers external editor workflow." - (init-state) - (on-key 24) ; Ctrl+X prefix - (on-key 5) ; Ctrl+E chord - (let ((msgs (st :messages))) - (fiveam:is (> (length msgs) 0)) - (fiveam:is (search "editor" (getf (elt msgs 0) :content) :test #'char-equal)))) - -(fiveam:test test-tab-completes-command - "Contract 1/v0.7.0: Tab completes /the to /theme." - (init-state) - (dolist (ch (coerce "/the" 'list)) - (on-key (char-code ch))) - (on-key 9) ; Tab - (fiveam:is (search "/theme" (input-string)))) - -(fiveam:test test-tab-completes-subcommand - "Contract 1/v0.7.0: /theme + Tab lists theme names." - (init-state) - (dolist (ch (coerce "/theme " 'list)) - (on-key (char-code ch))) - (on-key 9) ; Tab — should expand to a theme name - (let ((s (input-string))) - (fiveam:is (or (search "dark" s) (search "light" s) (search "solarized" s) (search "gruvbox" s))))) - -(fiveam:test test-tab-file-path-match - "Contract 1/v0.7.0: @ followed by Tab finds file completions or leaves input unchanged." - (init-state) - (dolist (ch (coerce "@core" 'list)) - (on-key (char-code ch))) - (let ((before (input-string))) - (on-key 9) ; Tab — should find "core-*.org" if files exist - (let ((after (input-string))) - ;; Either completed to a longer match or stayed the same (no files found) - (fiveam:is (>= (length after) (length before))) - (fiveam:is (search "@core" after))))) - -(fiveam:test test-scroll-notify-on-new-msg - "Contract 1/v0.7.0: add-msg sets :scroll-notify when user is scrolled up." - (init-state) - ;; User scrolls up — not at bottom - (setf (st :scroll-at-bottom) nil - (st :scroll-notify) nil) - (add-msg :agent "new message while scrolled up") - (fiveam:is (eq t (st :scroll-notify))) - ;; Reset: user scrolls back to bottom - (setf (st :scroll-at-bottom) t - (st :scroll-notify) nil) - (add-msg :agent "message while at bottom") - (fiveam:is (eq nil (st :scroll-notify)))) diff --git a/lisp/channel-tui-state.lisp b/lisp/channel-tui-state.lisp index 118ed02..0cc8ade 100644 --- a/lisp/channel-tui-state.lisp +++ b/lisp/channel-tui-state.lisp @@ -112,8 +112,6 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") :input-buffer nil :input-history nil :input-hpos 0 :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 () @@ -145,9 +143,6 @@ 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: if scrolled up, set notification flag - (unless (st :scroll-at-bottom) - (setf (st :scroll-notify) t)) (setf (st :dirty) (list t t nil))) (defun queue-event (ev) diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index 4206649..a2211bc 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -1,41 +1,3 @@ -(in-package :passepartout) - -(defun char-width (ch) - "Returns the terminal column width of character CH. -ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." - (let ((code (char-code ch))) - (cond - ((= code 9) 8) ; tab - ((= code 0) 0) ; null - ((< code 32) 0) ; control chars - ((<= code 127) 1) ; ASCII - ;; CJK Unified Ideographs - ((<= #x4E00 code #x9FFF) 2) - ((<= #x3400 code #x4DBF) 2) ; CJK Extension A - ;; Fullwidth Forms - ((<= #xFF01 code #xFF60) 2) - ((<= #xFFE0 code #xFFE6) 2) - ;; Hiragana, Katakana - ((<= #x3040 code #x309F) 2) - ((<= #x30A0 code #x30FF) 2) - ;; Hangul - ((<= #xAC00 code #xD7AF) 2) - ((<= #x1100 code #x11FF) 2) - ;; Emoji + Misc Symbols - ((<= #x1F300 code #x1F9FF) 2) ; Emoji, Symbols, Supplement - ((<= #x1FA00 code #x1FA6F) 2) ; Chess, Symbols Extended - ((<= #x2600 code #x27BF) 2) ; Misc Symbols, Dingbats - ((<= #x2300 code #x23FF) 2) ; Misc Technical - ;; Combining marks (zero-width) - ((<= #x0300 code #x036F) 0) ; Combining Diacritical Marks - ((<= #x1AB0 code #x1AFF) 0) ; Combining Diacritical Extended - ((<= #x1DC0 code #x1DFF) 0) ; Combining Diacritical Supplement - ((<= #x20D0 code #x20FF) 0) ; Combining Diacritical for Symbols - ((<= #xFE00 code #xFE0F) 0) ; Variation Selectors - ((<= #xFE20 code #xFE2F) 0) ; Combining Half Marks - ;; Default - (t 1)))) - (in-package :passepartout.channel-tui) (defun view-status (win) @@ -50,14 +12,12 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." (or (st :rule-count) 0) (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) + ;; Second line: Focus map (let ((focus-info (or (st :foveal-id) ""))) (when (and focus-info (> (length focus-info) 0)) (add-string win (format nil " [Focus: ~a]" focus-info) :y 2 :x 1 :fgcolor (theme-color :timestamp)))) - (add-string win (format nil " ~a" (now)) - :y 2 :x (max 1 (- (width win) 12)) - :fgcolor (theme-color :timestamp)) + (add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp)) (refresh win)) (defun word-wrap (text width) @@ -147,6 +107,30 @@ Returns list of trimmed strings. Single words wider than width are split." (when id (view-input iw)) (setf (st :dirty) (list nil nil nil)))) +(in-package :passepartout) + +(defun char-width (ch) + "Returns the terminal column width of character CH. +ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." + (let ((code (char-code ch))) + (cond + ((= code 9) 8) + ((< code 32) 0) + ((<= code 127) 1) + ((<= #x4E00 code #x9FFF) 2) + ((<= #x3400 code #x4DBF) 2) + ((<= #x3040 code #x309F) 2) + ((<= #x30A0 code #x30FF) 2) + ((<= #xAC00 code #xD7AF) 2) + ((<= #xFF01 code #xFF60) 2) + ((<= #xFFE0 code #xFFE6) 2) + ((<= #x1F300 code #x1F9FF) 2) + ((<= #x2600 code #x27BF) 2) + ((<= #x0300 code #x036F) 0) + ((<= #x20D0 code #x20FF) 0) + ((<= #xFE00 code #xFE0F) 0) + (t 1)))) + (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) @@ -171,19 +155,8 @@ Returns list of trimmed strings. Single words wider than width are split." (test test-char-width-cjk "Contract 5: CJK characters have width 2." - (is (= 2 (passepartout::char-width #\日))) - (is (= 2 (passepartout::char-width #\本))) - (is (= 2 (passepartout::char-width #\語)))) - -(test test-char-width-emoji - "Contract 5: emoji have width 2." - (is (= 2 (passepartout::char-width #\🐱))) - (is (= 2 (passepartout::char-width #\🎉)))) - -(test test-char-width-combining - "Contract 5: combining marks have width 0." - (is (= 0 (passepartout::char-width #\Combining_Grave_Accent)))) + (is (= 2 (passepartout::char-width #\日)))) (test test-char-width-null - "Contract 5: null character has width 0." + "Contract 5: null has width 0." (is (= 0 (passepartout::char-width #\Nul)))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index cea87e1..e7840e7 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -14,12 +14,7 @@ Event handlers + daemon I/O + main loop. expression, ~/focus ~ switches project context, ~/scope ~ changes context scope, ~/unfocus~ pops context, Tab completes command names, Backspace deletes, arrows scroll - chat and history. - v0.7.0: Ctrl+C interrupts (first press = interrupt tool, second within - 2s = abort turn, third = exit). Ctrl+L clears/redraws screen. - Ctrl+D quits on empty input. Ctrl+U clears line, Ctrl+W deletes word - backward. Ctrl+A/Ctrl+E = home/end. Ctrl+X+E opens $EDITOR with - current input. Non-printable keys are ignored. + chat and history. Non-printable keys are ignored. 2. (on-daemon-msg msg): processes inbound daemon messages. Routes text responses to chat display (:agent), handshake to system messages, routes errors to log via ~log-message~. Extracts @@ -47,41 +42,6 @@ Event handlers + daemon I/O + main loop. (or name raw)) raw))) (cond - ;; v0.7.0: if pending Ctrl+X and key is not E, clear the prefix - ((and (st :pending-ctrl-x) (not (eql ch 5))) - (setf (st :pending-ctrl-x) nil) - ;; Fall through to normal handling below — re-process the key - (on-key ch)) - ;; v0.7.0: Ctrl+X prefix — next key determines chord - ((eql ch 24) ; Ctrl+X - (setf (st :pending-ctrl-x) t)) - ((and (eql ch 5) (st :pending-ctrl-x)) ; Ctrl+X+E — external editor - (setf (st :pending-ctrl-x) nil) - (add-msg :system "Opening external editor... Write your prompt, save, and exit.") - (setf (st :dirty) (list t t nil))) - ;; v0.7.0: Ctrl key bindings - ((eql ch 3) ; Ctrl+C — interrupt/abort/exit cascade - (add-msg :system "[Ctrl+C: send /abort to interrupt, press again to exit]")) - ((eql ch 12) ; Ctrl+L — clear/redraw screen - (add-msg :system "Screen redrawn") - (setf (st :dirty) (list t t t))) - ((eql ch 4) ; Ctrl+D — quit on empty input - (if (or (null (st :input-buffer)) (string= "" (input-string))) - (add-msg :system "Press /quit to exit. Goodbye!"))) - ((eql ch 21) ; Ctrl+U — clear line - (setf (st :input-buffer) nil) - (setf (st :dirty) (list nil nil t))) - ((eql ch 23) ; Ctrl+W — delete word backward - (let ((buf (or (st :input-buffer) nil))) - (when buf - (loop while (and buf (char= (first buf) #\Space)) do (pop buf)) - (loop while (and buf (char/= (first buf) #\Space)) do (pop buf)) - (setf (st :input-buffer) buf) - (setf (st :dirty) (list nil nil t))))) - ((eql ch 1) ; Ctrl+A — home - (setf (st :cursor-pos) 0)) - ((eql ch 5) ; Ctrl+E — end - (setf (st :cursor-pos) (length (st :input-buffer)))) ;; Enter ((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch #\Newline) (eql ch #\Return)) @@ -192,63 +152,18 @@ 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 (v0.7.0: extended with subcommand + file paths) + ;; Tab — command completion ((or (eql ch 9) (eq ch :tab)) (let ((text (input-string))) (cond - ;; @ prefix — file path completion from memex/projects - ((and (>= (length text) 1) (eql (char text 0) #\@)) - (let* ((partial (subseq text 1)) - (proj-dir (merge-pathnames - (make-pathname :directory '(:relative "projects")) - (or (uiop:getenv "MEMEX_DIR") - (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))) - (org-files (handler-case (uiop:directory-files proj-dir "**/*.org") - (error () nil))) - (lisp-files (handler-case (uiop:directory-files proj-dir "**/*.lisp") - (error () nil))) - (all-files (mapcar #'namestring (append org-files lisp-files))) - (short-names (mapcar (lambda (f) - (subseq f (1+ (length (namestring proj-dir))))) - all-files)) - (match (find-if (lambda (n) - (and (>= (length n) (length partial)) - (string-equal n partial :end2 (length partial)))) - short-names))) - (when match - (setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list))) - (setf (st :dirty) (list nil nil t))))) - ;; /theme subcommand completion - ((and (>= (length text) 7) + ((and (>= (length text) 8) (string-equal (subseq text 0 7) "/theme ")) - (let* ((partial (string-trim '(#\Space) (subseq text 7))) + (let* ((partial (subseq text 7)) (names '("dark" "light" "solarized" "gruvbox")) - (match (if (string= partial "") - (first names) - (find partial names :test #'string-equal)))) + (match (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 — project directory completion - ((and (>= (length text) 7) - (string-equal (subseq text 0 7) "/focus ")) - (let* ((partial (string-trim '(#\Space) (subseq text 7))) - (memex-dir (or (uiop:getenv "MEMEX_DIR") - (namestring (merge-pathnames "memex/" (user-homedir-pathname))))) - (proj-dir (merge-pathnames (make-pathname :directory '(:relative "projects")) memex-dir)) - (dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d)))) - (uiop:subdirectories proj-dir)) - (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 completion — /prefix ((and (> (length text) 1) (eql (char text 0) #\/)) (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit")) (match (find text cmds :test @@ -510,8 +425,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 (vectorp (st :messages))) - (fiveam:is (= 0 (length (st :messages)))) + (fiveam:is (eq nil (st :messages))) (fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq nil (st :busy)))) @@ -671,98 +585,4 @@ Event handlers + daemon I/O + main loop. (fiveam:is (eq :yellow (getf *tui-theme* :system))) (fiveam:is (eq :cyan (getf *tui-theme* :input))) (fiveam:is (eq :white (theme-color :unknown-role)))) - -(fiveam:test test-on-key-ctrl-d-empty-quits - "Contract 1/v0.7.0: Ctrl+D on empty input adds quit system message." - (init-state) - (on-key 4) ; Ctrl+D - (let ((msgs (st :messages))) - (fiveam:is (> (length msgs) 0)) ; at least one message - (fiveam:is (search "quit" (getf (elt msgs 0) :content) :test #'char-equal)))) - -(fiveam:test test-on-key-ctrl-u-clears-line - "Contract 1/v0.7.0: Ctrl+U clears the input buffer." - (init-state) - (dolist (ch '(#\h #\e #\l #\l #\o)) - (on-key (char-code ch))) - (on-key 21) ; Ctrl+U - (fiveam:is (string= "" (input-string)))) - -(fiveam:test test-on-key-ctrl-a-moves-home - "Contract 1/v0.7.0: Ctrl+A moves cursor to position 0." - (init-state) - (dolist (ch '(#\h #\i)) - (on-key (char-code ch))) - (on-key 1) ; Ctrl+A - (fiveam:is (= 0 (or (st :cursor-pos) 0)))) - -(fiveam:test test-on-key-ctrl-e-moves-end - "Contract 1/v0.7.0: Ctrl+E moves cursor to end of input." - (init-state) - (dolist (ch '(#\h #\i)) - (on-key (char-code ch))) - (on-key 5) ; Ctrl+E - (fiveam:is (= 2 (or (st :cursor-pos) 0)))) - -(fiveam:test test-on-key-ctrl-l-redraws - "Contract 1/v0.7.0: Ctrl+L sets all dirty flags for full redraw." - (init-state) - (setf (st :dirty) (list nil nil nil)) - (on-key 12) ; Ctrl+L - (let ((d (st :dirty))) - (fiveam:is (eq t (first d))) - (fiveam:is (eq t (second d))) - (fiveam:is (eq t (third d))))) - -(fiveam:test test-on-key-ctrl-x-e-editor - "Contract 1/v0.7.0: Ctrl+X then Ctrl+E triggers external editor workflow." - (init-state) - (on-key 24) ; Ctrl+X prefix - (on-key 5) ; Ctrl+E chord - (let ((msgs (st :messages))) - (fiveam:is (> (length msgs) 0)) - (fiveam:is (search "editor" (getf (elt msgs 0) :content) :test #'char-equal)))) - -(fiveam:test test-tab-completes-command - "Contract 1/v0.7.0: Tab completes /the to /theme." - (init-state) - (dolist (ch (coerce "/the" 'list)) - (on-key (char-code ch))) - (on-key 9) ; Tab - (fiveam:is (search "/theme" (input-string)))) - -(fiveam:test test-tab-completes-subcommand - "Contract 1/v0.7.0: /theme + Tab lists theme names." - (init-state) - (dolist (ch (coerce "/theme " 'list)) - (on-key (char-code ch))) - (on-key 9) ; Tab — should expand to a theme name - (let ((s (input-string))) - (fiveam:is (or (search "dark" s) (search "light" s) (search "solarized" s) (search "gruvbox" s))))) - -(fiveam:test test-tab-file-path-match - "Contract 1/v0.7.0: @ followed by Tab finds file completions or leaves input unchanged." - (init-state) - (dolist (ch (coerce "@core" 'list)) - (on-key (char-code ch))) - (let ((before (input-string))) - (on-key 9) ; Tab — should find "core-*.org" if files exist - (let ((after (input-string))) - ;; Either completed to a longer match or stayed the same (no files found) - (fiveam:is (>= (length after) (length before))) - (fiveam:is (search "@core" after))))) - -(fiveam:test test-scroll-notify-on-new-msg - "Contract 1/v0.7.0: add-msg sets :scroll-notify when user is scrolled up." - (init-state) - ;; User scrolls up — not at bottom - (setf (st :scroll-at-bottom) nil - (st :scroll-notify) nil) - (add-msg :agent "new message while scrolled up") - (fiveam:is (eq t (st :scroll-notify))) - ;; Reset: user scrolls back to bottom - (setf (st :scroll-at-bottom) t - (st :scroll-notify) nil) - (add-msg :agent "message while at bottom") - (fiveam:is (eq nil (st :scroll-notify)))) #+end_src diff --git a/org/channel-tui-state.org b/org/channel-tui-state.org index 7f0a577..8c93096 100644 --- a/org/channel-tui-state.org +++ b/org/channel-tui-state.org @@ -10,9 +10,6 @@ All state mutation flows through event handlers in the controller. 1. (init-state): returns a fresh state plist with ~:msgs~ list, ~:input~ buffer, ~:dirty~ flag, ~:busy~ flag, and ~:connection~ status. - v0.7.0: ~:scroll-at-bottom~ flag tracks whether the user is scrolled to - the bottom. ~add-msg~ sets ~:scroll-notify~ t when a new message arrives - and the user is scrolled up. 2. (add-msg role content &key gate-trace): appends a message object to the ~:messages~ vector (v0.3.3), tagged with timestamp, role, and optional gate-trace from the daemon (v0.4.0). @@ -135,8 +132,6 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") :input-buffer nil :input-history nil :input-hpos 0 :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 @@ -171,9 +166,6 @@ 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: if scrolled up, set notification flag - (unless (st :scroll-at-bottom) - (setf (st :scroll-notify) t)) (setf (st :dirty) (list t t nil))) #+end_src diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index 94ddf4b..c37ea00 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -24,49 +24,6 @@ State is read via ~(st :key)~ — no mutation here. 6. (view-status win): v0.7.0 — timestamp right-aligned at (- w 12) on line 2, focus info at :x 1. No overlap. -* Implementation - -** Unicode width (v0.7.0) -#+begin_src lisp -(in-package :passepartout) - -(defun char-width (ch) - "Returns the terminal column width of character CH. -ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." - (let ((code (char-code ch))) - (cond - ((= code 9) 8) ; tab - ((= code 0) 0) ; null - ((< code 32) 0) ; control chars - ((<= code 127) 1) ; ASCII - ;; CJK Unified Ideographs - ((<= #x4E00 code #x9FFF) 2) - ((<= #x3400 code #x4DBF) 2) ; CJK Extension A - ;; Fullwidth Forms - ((<= #xFF01 code #xFF60) 2) - ((<= #xFFE0 code #xFFE6) 2) - ;; Hiragana, Katakana - ((<= #x3040 code #x309F) 2) - ((<= #x30A0 code #x30FF) 2) - ;; Hangul - ((<= #xAC00 code #xD7AF) 2) - ((<= #x1100 code #x11FF) 2) - ;; Emoji + Misc Symbols - ((<= #x1F300 code #x1F9FF) 2) ; Emoji, Symbols, Supplement - ((<= #x1FA00 code #x1FA6F) 2) ; Chess, Symbols Extended - ((<= #x2600 code #x27BF) 2) ; Misc Symbols, Dingbats - ((<= #x2300 code #x23FF) 2) ; Misc Technical - ;; Combining marks (zero-width) - ((<= #x0300 code #x036F) 0) ; Combining Diacritical Marks - ((<= #x1AB0 code #x1AFF) 0) ; Combining Diacritical Extended - ((<= #x1DC0 code #x1DFF) 0) ; Combining Diacritical Supplement - ((<= #x20D0 code #x20FF) 0) ; Combining Diacritical for Symbols - ((<= #xFE00 code #xFE0F) 0) ; Variation Selectors - ((<= #xFE20 code #xFE2F) 0) ; Combining Half Marks - ;; Default - (t 1)))) -#+end_src - ** Status Bar The status bar, as of v0.4.0, renders Passepartout's three differentiator @@ -207,6 +164,33 @@ Returns list of trimmed strings. Single words wider than width are split." (setf (st :dirty) (list nil nil nil)))) #+end_src +* Implementation — v0.7.0 additions +#+begin_src lisp +(in-package :passepartout) + +(defun char-width (ch) + "Returns the terminal column width of character CH. +ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." + (let ((code (char-code ch))) + (cond + ((= code 9) 8) + ((< code 32) 0) + ((<= code 127) 1) + ((<= #x4E00 code #x9FFF) 2) + ((<= #x3400 code #x4DBF) 2) + ((<= #x3040 code #x309F) 2) + ((<= #x30A0 code #x30FF) 2) + ((<= #xAC00 code #xD7AF) 2) + ((<= #xFF01 code #xFF60) 2) + ((<= #xFFE0 code #xFFE6) 2) + ((<= #x1F300 code #x1F9FF) 2) + ((<= #x2600 code #x27BF) 2) + ((<= #x0300 code #x036F) 0) + ((<= #x20D0 code #x20FF) 0) + ((<= #xFE00 code #xFE0F) 0) + (t 1)))) +#+end_src + * Test Suite #+begin_src lisp (eval-when (:compile-toplevel :load-toplevel :execute) @@ -233,20 +217,9 @@ Returns list of trimmed strings. Single words wider than width are split." (test test-char-width-cjk "Contract 5: CJK characters have width 2." - (is (= 2 (passepartout::char-width #\日))) - (is (= 2 (passepartout::char-width #\本))) - (is (= 2 (passepartout::char-width #\語)))) - -(test test-char-width-emoji - "Contract 5: emoji have width 2." - (is (= 2 (passepartout::char-width #\🐱))) - (is (= 2 (passepartout::char-width #\🎉)))) - -(test test-char-width-combining - "Contract 5: combining marks have width 0." - (is (= 0 (passepartout::char-width #\Combining_Grave_Accent)))) + (is (= 2 (passepartout::char-width #\日)))) (test test-char-width-null - "Contract 5: null character has width 0." + "Contract 5: null has width 0." (is (= 0 (passepartout::char-width #\Nul)))) #+end_src