passepartout: v0.7.0 — Status bar fix, unicode width, Ctrl key bindings
This commit is contained in:
@@ -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)))))
|
||||
|
||||
@@ -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)
|
||||
@@ -106,3 +144,44 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(when cd (view-chat cw ch))
|
||||
(when id (view-input iw))
|
||||
(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))))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -156,3 +206,47 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(when id (view-input iw))
|
||||
(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
|
||||
|
||||
Reference in New Issue
Block a user