v0.7.0: scroll notify + autocomplete — TDD
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user