v0.7.0: char-width + status bar fix — TDD (RED→GREEN)
char-width: contract 5, 4 tests (6 assertions), 100% pass ASCII=1, CJK/Hangul/Kana/halfwidth=2, combining marks=0, tab=8 Pure Lisp, ~25 lines, no deps. Used by word-wrap for unicode. status bar: contract 6, timestamp right-aligned at (- w 12) Fixes overlap where focus map and timestamp both drew at :y 2 :x 1
This commit is contained in:
@@ -14,12 +14,7 @@ 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.
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user