amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v0.7.0: scroll notify + autocomplete — TDD
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Details

Browse Source 
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:
Amr Gharbeia
2026-05-08 11:09:07 -04:00
parent 30913bf327
commit f508dec080
5 changed files with 138 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
org/channel-tui-main.org
View File

@@ -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

4
org/channel-tui-state.org
View File

@@ -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