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

v0.7.2: message search mode — navigate, highlight, jump — TDD

Browse Source 
Search mode activated by /search <query>. State fields: :search-mode,
:search-query, :search-matches, :search-match-idx. Up/Down arrows
navigate between matches, Enter jumps to current match, Escape exits.

search-highlight wraps matching substrings in **bold** for markdown
rendering. View-chat shows search header bar with match count and
current position.

- channel-tui-state: 4 search state fields in init-state
- channel-tui-main: modified /search handler, search-mode key handlers
  (Up/Down/Enter/Escape), 3 new tests (activate, escape, nav)
- channel-tui-view: search-highlight fn, search header bar,
  highlighted content in count+render loops
- TUI Main: 97/98 (1 pre-existing flake)  View: 29/29
This commit is contained in:
Amr Gharbeia
2026-05-08 21:02:45 -04:00
parent 93a38d5308
commit 06aff97b4e
6 changed files with 312 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files

155
lisp/channel-tui-main.lisp
View File

@@ -11,20 +11,57 @@
(or name raw))
raw)))
(cond
;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
(setf (getf (aref (st :messages) idx) :content)
(concatenate 'string
(getf (aref (st :messages) idx) :content)
" [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now))))
(setf (st :streaming-text) nil)
(setf (st :busy) nil)
(setf (st :dirty) (list t t nil)))
;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
(setf (getf (aref (st :messages) idx) :content)
(concatenate 'string
(getf (aref (st :messages) idx) :content)
" [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now))))
(setf (st :streaming-text) nil)
(setf (st :busy) nil)
(setf (st :dirty) (list t t nil)))
;; v0.7.2: Esc — exit search mode
((and (eql ch 27) (st :search-mode))
(setf (st :search-mode) nil
(st :search-matches) nil
(st :search-query) "")
(setf (st :dirty) (list nil t nil))
(add-msg :system "Search exited"))
;; v0.7.2: search mode — Up/Down navigate matches
((and (st :search-mode) (or (eql ch 259) (eq ch :up)))
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(new-idx (max 0 (1- idx))))
(setf (st :search-match-idx) new-idx)
(when matches
(setf (st :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil)))))
((and (st :search-mode) (or (eql ch 258) (eq ch :down)))
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(new-idx (min (1- (length matches)) (1+ idx))))
(setf (st :search-match-idx) new-idx)
(when matches
(setf (st :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil)))))
;; v0.7.2: search mode — Enter jumps to current match
((and (st :search-mode) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
(let ((matches (st :search-matches))
(idx (st :search-match-idx)))
(when (and matches (>= (length matches) (1+ idx)))
(setf (st :scroll-offset) (nth idx matches))
(setf (st :search-mode) nil
(st :search-matches) nil
(st :search-query) "")
(add-msg :system (format nil "Jumped to match ~d" (1+ idx)))
(setf (st :dirty) (list nil t nil)))))
;; v0.7.1: Tab on empty input — extract then open URL from agent message
((and (or (eql ch 9) (eq ch :tab))
(null (st :input-buffer)))
@@ -222,33 +259,27 @@
;; /context dropped — pruned nodes
((string-equal text "/context dropped")
(add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
;; /search command — message search
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
(msgs (st :messages))
(total (length msgs))
(matches nil))
(loop for i from 0 below total
for m = (aref msgs i)
for content = (getf m :content)
when (search query (string-downcase content))
do (push (list i content) matches))
(setf matches (nreverse matches))
(if matches
(progn
(add-msg :system (format nil "Found ~d matches for '~a':"
(length matches) query))
(dolist (match matches)
(let* ((idx (first match))
(content (second match))
(pos (search query (string-downcase content)))
(preview (if (> (length content) 60)
(concatenate 'string
(subseq content (max 0 (- pos 20)) (min (length content) (+ pos 40)))
"...")
content)))
(add-msg :system (format nil " #~d: ...~a..." idx preview)))))
(add-msg :system (format nil "No matches for '~a'" query)))))
;; /search command — message search
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
(msgs (st :messages))
(total (length msgs))
(matches nil))
(loop for i from 0 below total
for m = (aref msgs i)
for content = (getf m :content)
when (search query (string-downcase content))
do (push i matches))
(setf matches (nreverse matches))
;; Enter search mode
(setf (st :search-mode) t
(st :search-query) query
(st :search-matches) matches
(st :search-match-idx) 0)
(if matches
(add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit"
(length matches) query (length matches)))
(add-msg :system (format nil "0 matches for '~a'" query)))))
;; /rewind command — session rewind
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
@@ -1127,3 +1158,45 @@
(on-key 7)
(let ((m (aref (st :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content)))))
;; ── v0.7.2 Message Search Mode ──
(fiveam:test test-search-mode-activate
"Contract v0.7.2: /search enters search mode."
(init-state)
(add-msg :agent "hello world")
(add-msg :agent "goodbye")
(dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch)))
(on-key 13)
(fiveam:is (eq t (st :search-mode)))
(fiveam:is (string= "hello" (st :search-query)))
(fiveam:is (= 1 (length (st :search-matches)))))
(fiveam:test test-search-mode-escape-exits
"Contract v0.7.2: Escape exits search mode."
(init-state)
(add-msg :agent "test")
(dolist (ch (coerce "/search test" 'list))
(on-key (char-code ch)))
(on-key 13)
(fiveam:is (eq t (st :search-mode)))
(on-key 27) ;; Escape
(fiveam:is (null (st :search-mode))))
(fiveam:test test-search-mode-up-down-nav
"Contract v0.7.2: Up/Down navigates between search matches."
(init-state)
(add-msg :agent "aaa hello bbb")
(add-msg :agent "ccc hello ddd")
(add-msg :agent "no match here")
(dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch)))
(on-key 13)
(fiveam:is (= 0 (st :search-match-idx)))
(on-key 258) ;; Down
(fiveam:is (= 1 (st :search-match-idx)))
(on-key 259) ;; Up
(fiveam:is (= 0 (st :search-match-idx)))
(on-key 259) ;; Up (clamped)
(fiveam:is (= 0 (st :search-match-idx))))

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

@@ -116,7 +116,9 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:pending-ctrl-x nil
:scroll-at-bottom t :scroll-notify nil
:streaming-text nil :url-buffer nil ; v0.7.1
:collapsed-gates nil ; v0.7.2
:collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0
:dirty (list nil nil nil))))
(defun now ()

70
lisp/channel-tui-view.lisp
View File

@@ -23,31 +23,22 @@
:fgcolor (theme-color :timestamp))
(refresh win))
(defun word-wrap (text width)
"Break text into lines at word boundaries, each <= width chars.
Returns list of trimmed strings. Single words wider than width are split."
(let ((lines '())
(pos 0)
(len (length text)))
(loop while (< pos len)
do (let ((end (min len (+ pos width))))
(cond
((>= end len)
(push (string-trim '(#\Space) (subseq text pos len)) lines)
(setf pos len))
((char= (char text (1- end)) #\Space)
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))
(t
(let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
(if (and last-space (> last-space pos))
(progn
(push (string-trim '(#\Space) (subseq text pos last-space)) lines)
(setf pos (1+ last-space)))
(progn
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))))))))
(nreverse lines)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
"Wrap occurrences of QUERY in CONTENT with **bold** markers."
(let ((lower-content (string-downcase content))
(lower-query (string-downcase query))
(result "") (pos 0))
(when (and query (> (length query) 0))
(loop
(let ((found (search lower-query lower-content :start2 pos)))
(unless found (return))
(setf result (concatenate 'string result
(subseq content pos found)
"**" (subseq content found (+ found (length query))) "**"))
(setf pos (+ found (length query)))))
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
@@ -56,18 +47,32 @@ Returns list of trimmed strings. Single words wider than width are split."
(msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
(y 1))
;; v0.7.2: search mode header
(when is-search
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
(let* ((msg-count 0)
(lines-remaining max-lines))
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
@@ -86,7 +91,10 @@ Returns list of trimmed strings. Single words wider than width are split."
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(is-panel (getf msg :panel))
(is-resolved (getf msg :panel-resolved))
(line-text (format nil "~a [~a] ~a" prefix time content))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2))))
;; HITL panel: render with colored border
(when is-panel