v0.3.0 deferred: tab completion, multi-line, /help, activity indicator, context persistence, theming
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
- Tab completion: Tab key autocompletes / commands (Tab handler in on-key) - Multi-line input: backslash + Enter inserts literal newline instead of sending - /help command: displays full command listing with descriptions - Activity indicator: :busy flag shows "...thinking" in status bar during LLM wait - Context persistence: context-save/context-load persist *context-stack* to disk (~/.cache/passepartout/context.lisp). Auto-restores on skill load. Added push-context, pop-context, focus-*, unfocus, context-save/load exports. - Theming: *tui-theme* plist with semantic color roles, /theme command View functions (view-chat, view-status, view-input) use theme-color - TUI test suite: 19 tests, 53 checks (100% pass) - Context test suite: 2 tests, 6 checks (100% pass) - Total: 5 suites, 81 checks, 0 failures
This commit is contained in:
@@ -3,61 +3,105 @@
|
||||
(defun on-key (&rest args)
|
||||
(let ((ch (car args)))
|
||||
(cond
|
||||
;; Enter
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
(let ((text (string-trim '(#\Space #\Tab) (input-string))))
|
||||
(when (> (length text) 0)
|
||||
(push text (st :input-history))
|
||||
(setf (st :input-hpos) 0)
|
||||
(setf (st :scroll-offset) 0)
|
||||
(cond
|
||||
;; /eval command
|
||||
((and (>= (length text) 6)
|
||||
(string-equal (subseq text 0 6) "/eval "))
|
||||
(handler-case
|
||||
(let* ((*read-eval* t)
|
||||
(*package* (find-package :passepartout.gateway-tui))
|
||||
(r (eval (read-from-string (subseq text 6)))))
|
||||
(add-msg :system (format nil "=> ~s" r)))
|
||||
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
|
||||
;; /focus <project> — set project context
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/focus "))
|
||||
(let ((project (string-trim '(#\Space) (subseq text 7))))
|
||||
(if (and (fboundp 'focus-project) (> (length project) 0))
|
||||
(progn (funcall 'focus-project project nil)
|
||||
(add-msg :system (format nil "Focused on project: ~a" project)))
|
||||
(add-msg :system "Usage: /focus <project-name>"))))
|
||||
;; /scope <scope> — change context scope
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/scope "))
|
||||
(let ((scope-str (string-trim '(#\Space) (subseq text 7))))
|
||||
(cond
|
||||
((and (fboundp 'focus-session) (string-equal scope-str "session"))
|
||||
(funcall 'focus-session)
|
||||
(add-msg :system "Scope: session"))
|
||||
((and (fboundp 'focus-project) (string-equal scope-str "project"))
|
||||
(funcall 'focus-project nil nil)
|
||||
(add-msg :system "Scope: project"))
|
||||
((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
|
||||
(funcall 'focus-memex)
|
||||
(add-msg :system "Scope: memex"))
|
||||
(t (add-msg :system "Usage: /scope memex|session|project")))))
|
||||
;; /unfocus — pop context
|
||||
((and (>= (length text) 8)
|
||||
(string-equal (subseq text 0 8) "/unfocus"))
|
||||
(if (fboundp 'unfocus)
|
||||
(progn (funcall 'unfocus)
|
||||
(add-msg :system "Popped context"))
|
||||
(add-msg :system "Context manager not loaded")))
|
||||
;; Normal message
|
||||
(t
|
||||
(add-msg :user text)
|
||||
(send-daemon (list :type :event
|
||||
:payload (list :sensor :user-input :text text)))))
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :dirty) (list t t t)))))
|
||||
;; Enter
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter)
|
||||
(eql ch #\Newline) (eql ch #\Return))
|
||||
;; Multi-line: if buffer ends with \, strip it and insert newline
|
||||
(if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\))
|
||||
(progn (pop (st :input-buffer))
|
||||
(push #\Newline (st :input-buffer))
|
||||
(setf (st :dirty) (list nil nil t)))
|
||||
(let ((text (string-trim '(#\Space #\Tab) (input-string))))
|
||||
(when (> (length text) 0)
|
||||
(push text (st :input-history))
|
||||
(setf (st :input-hpos) 0)
|
||||
(setf (st :scroll-offset) 0)
|
||||
(cond
|
||||
;; /help command
|
||||
((string-equal text "/help")
|
||||
(add-msg :system
|
||||
"/eval <expr> Evaluate Lisp expression")
|
||||
(add-msg :system
|
||||
"/focus <proj> Set project context")
|
||||
(add-msg :system
|
||||
"/scope <s> Change scope (memex/session/project)")
|
||||
(add-msg :system
|
||||
"/unfocus Pop context stack")
|
||||
(add-msg :system
|
||||
"/theme Show current color theme")
|
||||
(add-msg :system
|
||||
"/help Show this help")
|
||||
(add-msg :system
|
||||
"\\ + Enter Multi-line input"))
|
||||
;; /theme command
|
||||
((string-equal text "/theme")
|
||||
(add-msg :system
|
||||
(format nil "Theme: user=~a agent=~a system=~a input=~a"
|
||||
(getf *tui-theme* :user)
|
||||
(getf *tui-theme* :agent)
|
||||
(getf *tui-theme* :system)
|
||||
(getf *tui-theme* :input))))
|
||||
;; /eval command
|
||||
((and (>= (length text) 6)
|
||||
(string-equal (subseq text 0 6) "/eval "))
|
||||
(handler-case
|
||||
(let* ((*read-eval* t)
|
||||
(*package* (find-package :passepartout.gateway-tui))
|
||||
(r (eval (read-from-string (subseq text 6)))))
|
||||
(add-msg :system (format nil "=> ~s" r)))
|
||||
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
|
||||
;; /focus <project> — set project context
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/focus "))
|
||||
(let ((project (string-trim '(#\Space) (subseq text 7))))
|
||||
(if (and (fboundp 'focus-project) (> (length project) 0))
|
||||
(progn (funcall 'focus-project project nil)
|
||||
(add-msg :system (format nil "Focused on project: ~a" project)))
|
||||
(add-msg :system "Usage: /focus <project-name>"))))
|
||||
;; /scope <scope> — change context scope
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/scope "))
|
||||
(let ((scope-str (string-trim '(#\Space) (subseq text 7))))
|
||||
(cond
|
||||
((and (fboundp 'focus-session) (string-equal scope-str "session"))
|
||||
(funcall 'focus-session)
|
||||
(add-msg :system "Scope: session"))
|
||||
((and (fboundp 'focus-project) (string-equal scope-str "project"))
|
||||
(funcall 'focus-project nil nil)
|
||||
(add-msg :system "Scope: project"))
|
||||
((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
|
||||
(funcall 'focus-memex)
|
||||
(add-msg :system "Scope: memex"))
|
||||
(t (add-msg :system "Usage: /scope memex|session|project")))))
|
||||
;; /unfocus — pop context
|
||||
((and (>= (length text) 8)
|
||||
(string-equal (subseq text 0 8) "/unfocus"))
|
||||
(if (fboundp 'unfocus)
|
||||
(progn (funcall 'unfocus)
|
||||
(add-msg :system "Popped context"))
|
||||
(add-msg :system "Context manager not loaded")))
|
||||
;; Normal message
|
||||
(t
|
||||
(add-msg :user text)
|
||||
(setf (st :busy) t)
|
||||
(send-daemon (list :type :event
|
||||
:payload (list :sensor :user-input :text text)))))
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :dirty) (list t t t))))))
|
||||
;; Tab — command completion
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
(let ((text (input-string)))
|
||||
(when (and (> (length text) 1) (eql (char text 0) #\/))
|
||||
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme"))
|
||||
(match (find text cmds :test
|
||||
(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=)
|
||||
(push #\Space (st :input-buffer)))
|
||||
(setf (st :dirty) (list nil nil t)))))))
|
||||
;; Backspace
|
||||
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
||||
(when (st :input-buffer) (pop (st :input-buffer)))
|
||||
@@ -103,7 +147,8 @@
|
||||
(text (getf payload :text))
|
||||
(action (getf payload :action)))
|
||||
(cond
|
||||
(text (add-msg :agent text))
|
||||
(text (setf (st :busy) nil)
|
||||
(add-msg :agent text))
|
||||
((eq action :handshake)
|
||||
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
|
||||
(t (add-msg :agent (format nil "~a" msg))))))
|
||||
@@ -214,7 +259,8 @@
|
||||
(fiveam:is (eq nil (st :connected)))
|
||||
(fiveam:is (eq nil (st :stream)))
|
||||
(fiveam:is (eq nil (st :messages)))
|
||||
(fiveam:is (eq 0 (st :scroll-offset))))
|
||||
(fiveam:is (eq 0 (st :scroll-offset)))
|
||||
(fiveam:is (eq nil (st :busy))))
|
||||
|
||||
(fiveam:test test-add-msg
|
||||
"Contract model.2: add-msg appends a message with role, content, and time."
|
||||
@@ -343,3 +389,61 @@
|
||||
(on-key 13)
|
||||
(let ((msg (first (st :messages))))
|
||||
(fiveam:is (eq :system (getf msg :role)))))
|
||||
|
||||
(fiveam:test test-on-key-tab-completion
|
||||
"Contract 1: Tab completes / commands when input starts with /."
|
||||
(init-state)
|
||||
;; Type "/ev" then Tab
|
||||
(dolist (ch (coerce "/ev" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab
|
||||
(fiveam:is (string= "/eval " (input-string))))
|
||||
|
||||
(fiveam:test test-on-key-tab-no-slash
|
||||
"Contract 1: Tab does nothing when input doesn't start with /."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "hello" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 9) ; Tab
|
||||
(fiveam:is (string= "hello" (input-string))))
|
||||
|
||||
(fiveam:test test-on-key-multiline
|
||||
"Contract 1: \\ + Enter inserts newline instead of sending."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "line1" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key (char-code #\\))
|
||||
(on-key 13)
|
||||
(fiveam:is (search "line1" (input-string)))
|
||||
(fiveam:is (search (string #\Newline) (input-string))))
|
||||
|
||||
(fiveam:test test-on-key-help
|
||||
"Contract 1: /help displays command list."
|
||||
(init-state)
|
||||
(dolist (ch (coerce "/help" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(let ((msgs (st :messages)))
|
||||
(fiveam:is (>= (length msgs) 3))
|
||||
(fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))
|
||||
|
||||
(fiveam:test test-activity-indicator
|
||||
"Contract model: :busy flag is set on send and cleared on agent response."
|
||||
(init-state)
|
||||
(fiveam:is (eq nil (st :busy)))
|
||||
;; Simulate sending a normal message (sets busy)
|
||||
(dolist (ch (coerce "hello" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(fiveam:is (eq t (st :busy)))
|
||||
;; Simulate receiving an agent response (clears busy)
|
||||
(on-daemon-msg '(:type :event :payload (:text "hi back")))
|
||||
(fiveam:is (eq nil (st :busy))))
|
||||
|
||||
(fiveam:test test-theme
|
||||
"Contract view: *tui-theme* provides color mappings."
|
||||
(fiveam:is (eq :green (getf *tui-theme* :user)))
|
||||
(fiveam:is (eq :white (getf *tui-theme* :agent)))
|
||||
(fiveam:is (eq :yellow (getf *tui-theme* :system)))
|
||||
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
|
||||
(fiveam:is (eq :white (theme-color :unknown-role))))
|
||||
|
||||
Reference in New Issue
Block a user