passepartout: v0.7.0 — Status bar fix, unicode width, Ctrl key bindings

This commit is contained in:
2026-05-08 10:24:53 -04:00
parent 72f032fd67
commit 66df5b493a
4 changed files with 312 additions and 5 deletions

View File

@@ -11,6 +11,29 @@
(or name raw))
raw)))
(cond
;; 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))
@@ -541,3 +564,45 @@
(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)))))

View File

@@ -1,3 +1,41 @@
(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)
@@ -105,4 +143,45 @@ Returns list of trimmed strings. Single words wider than width are split."
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
(setf (st :dirty) (list nil nil nil))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(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))))
(test test-char-width-null
"Contract 5: null character has width 0."
(is (= 0 (passepartout::char-width #\Nul))))

View File

@@ -14,7 +14,11 @@ Event handlers + daemon I/O + main loop.
expression, ~/focus <proj>~ switches project context,
~/scope <scope>~ changes context scope, ~/unfocus~ pops context,
Tab completes command names, Backspace deletes, arrows scroll
chat and history. Non-printable keys are ignored.
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. 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
@@ -42,6 +46,29 @@ Event handlers + daemon I/O + main loop.
(or name raw))
raw)))
(cond
;; 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))
@@ -585,4 +612,46 @@ 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)))))
#+end_src

View File

@@ -18,6 +18,54 @@ State is read via ~(st :key)~ — no mutation here.
indicator.
4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~
flags (status, chat, input). Minimizes terminal writes.
5. (char-width ch): returns the terminal column width of character CH.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
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
@@ -52,12 +100,14 @@ that the TUI actuator attaches to the response plist before transmission.
(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
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(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 1 :fgcolor (theme-color :timestamp))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
#+end_src
@@ -154,5 +204,49 @@ Returns list of trimmed strings. Single words wider than width are split."
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
(setf (st :dirty) (list nil nil nil))))
#+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(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))))
(test test-char-width-null
"Contract 5: null character has width 0."
(is (= 0 (passepartout::char-width #\Nul))))
#+end_src