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

v0.3.3: SIGWINCH, scroll clamp, /quit, /reconnect, history, message vector

Browse Source 
SIGWINCH: handle KEY_RESIZE (410) in main loop — re-measure screen,
re-create status/chat/input windows at new dimensions, force redraw.

Scroll clamp: PageUp clamped to (max 0 (- total 1)), prevents scrolling
past message list end. Status bar shows 'msgs:N scroll:0'.

/quit: saves :input-history to ~/.cache/passepartout/history (one line
per entry, most recent first), sends goodbye handshake, sets :running nil.

/reconnect: closes stale socket via disconnect-daemon, re-runs
connect-daemon with retry backoff. Connection-loss detection: reader-loop
counts consecutive nils; after 10, queues :disconnected event. Handler
clears :connected/:busy, shows red system message.

Load-history: reads ~/.cache/passepartout/history on startup, populates
:input-history for up-arrow recall.

Message vector: :messages init as adjustable vector with fill pointer.
add-msg uses vector-push-extend (O(1) append). view-chat uses aref
(O(1) access) instead of nth (O(n) for lists).
This commit is contained in:
Amr Gharbeia
2026-05-06 17:59:12 -04:00
parent 9350cb855e
commit 08602ed2d6
6 changed files with 216 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

132
lisp/gateway-tui-main.lisp
View File

@@ -88,7 +88,23 @@
(progn (funcall 'unfocus) (progn (funcall 'unfocus)
(add-msg :system "Popped context")) (add-msg :system "Popped context"))
(add-msg :system "Context manager not loaded"))) (add-msg :system "Context manager not loaded")))
;; Normal message ;; /quit — save history and exit
((or (string-equal text "/quit") (string-equal text "/q"))
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
(user-homedir-pathname))))
(uiop:ensure-all-directories-exist (list hist-file))
(with-open-file (out hist-file :direction :output
:if-exists :supersede :if-does-not-exist :create)
(dolist (entry (reverse (st :input-history)))
(write-line entry out))))
(add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil))
;; /reconnect — re-establish daemon connection
((string-equal text "/reconnect")
(disconnect-daemon)
(connect-daemon))
;; Normal message
(t (t
(add-msg :user text) (add-msg :user text)
(setf (st :busy) t) (setf (st :busy) t)
@@ -127,31 +143,32 @@
(incf (st :cursor-pos)) (incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (st :dirty) (list nil nil t))))
;; Up arrow ;; Up arrow
((or (eq ch :up) (eql ch 259)) ((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos))) (let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h)))) (when (and h (< p (1- (length h))))
(incf (st :input-hpos)) (incf (st :input-hpos))
(setf (st :input-buffer) (setf (st :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list))) (reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (st :dirty) (list nil nil t)))))
;; Down arrow ;; Down arrow
((or (eq ch :down) (eql ch 258)) ((or (eq ch :down) (eql ch 258))
(when (> (st :input-hpos) 0) (when (> (st :input-hpos) 0)
(decf (st :input-hpos)) (decf (st :input-hpos))
(let ((h (st :input-history))) (let ((h (st :input-history)))
(setf (st :input-buffer) (setf (st :input-buffer)
(if (and h (< (st :input-hpos) (length h))) (if (and h (< (st :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list)) (reverse (coerce (nth (st :input-hpos) h) 'list))
nil)) nil))
(setf (st :dirty) (list nil nil t))))) (setf (st :dirty) (list nil nil t)))))
;; PageUp ;; PageUp
((or (eq ch :ppage) (eql ch 339)) ((or (eq ch :ppage) (eql ch 339))
(incf (st :scroll-offset) 5) (let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :dirty) (list nil t nil))) (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
;; PageDown (setf (st :dirty) (list nil t nil)))
((or (eq ch :npage) (eql ch 338)) ;; PageDown
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5))) ((or (eq ch :npage) (eql ch 338))
(setf (st :dirty) (list nil t nil))) (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable ;; Printable
(t (t
(let ((chr (typecase ch (let ((chr (typecase ch
@@ -201,11 +218,28 @@
(error () nil))) (error () nil)))
(defun reader-loop (s) (defun reader-loop (s)
(loop while (and (st :running) (open-stream-p s)) (let ((consecutive-nils 0))
do (let ((msg (recv-daemon s))) (loop while (and (st :running) (open-stream-p s))
(if msg do (let ((msg (recv-daemon s)))
(queue-event (list :type :daemon :payload msg)) (if msg
(sleep 0.5))))) (progn (queue-event (list :type :daemon :payload msg))
(setf consecutive-nils 0))
(progn (sleep 0.5)
(incf consecutive-nils)
(when (> consecutive-nils 10)
(queue-event (list :type :disconnected))
(return))))))))
(defun load-history ()
"Load input history from disk on TUI startup."
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
(user-homedir-pathname))))
(when (uiop:file-exists-p hist-file)
(with-open-file (in hist-file :direction :input)
(loop for line = (read-line in nil nil)
while line
do (push line (st :input-history))))
(setf (st :input-history) (nreverse (st :input-history))))))
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105)) (defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(add-msg :system "* Connecting to daemon... *") (add-msg :system "* Connecting to daemon... *")
@@ -239,6 +273,7 @@
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil) (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24)) (let* ((h (or (height scr) 24))
(w (or (width scr) 80)) (w (or (width scr) 80))
@@ -251,7 +286,9 @@
4006))) 4006)))
(setf (function-keys-enabled-p iw) t (setf (function-keys-enabled-p iw) t
(input-blocking iw) nil (input-blocking iw) nil
(st :dirty) (list t t t)) (st :dirty) (list t t t)
;; Store windows in state for SIGWINCH handler
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
(connect-daemon) (connect-daemon)
(when (> swank-port 0) (when (> swank-port 0)
(handler-case (handler-case
@@ -269,11 +306,34 @@
(refresh scr) (refresh scr)
(loop while (st :running) do (loop while (st :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
(when (eq (getf ev :type) :daemon) (cond
(on-daemon-msg (getf ev :payload)))) ((eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload)))
((eq (getf ev :type) :disconnected)
(setf (st :connected) nil
(st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
(let ((ch (get-char iw))) (let ((ch (get-char iw)))
(when (and ch (not (equal ch -1))) (cond
(on-key ch))) ((or (not ch) (equal ch -1)) nil)
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
((eql ch 410)
(let* ((new-h (or (height scr) 24))
(new-w (or (width scr) 80))
(new-ch (- new-h 5)))
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
ch new-ch
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
w new-w
h new-h)
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
(st :sw) sw (st :cw) cw (st :iw) iw)
(redraw sw cw ch iw)
(refresh scr)))
(t (on-key ch))))
(redraw sw cw ch iw) (redraw sw cw ch iw)
(refresh scr) (refresh scr)
(sleep 0.03)) (sleep 0.03))

5
lisp/gateway-tui-model.lisp
View File

@@ -28,7 +28,8 @@
(setf *state* (setf *state*
(list :running t :mode :chat :connected nil :stream nil (list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0 :input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :busy nil :cursor-pos 0 :messages (make-array 16 :adjustable t :fill-pointer 0)
:scroll-offset 0 :busy nil :cursor-pos 0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
(defun now () (defun now ()
@@ -59,7 +60,7 @@
(setf (st :cursor-pos) (1- pos)))))) (setf (st :cursor-pos) (1- pos))))))
(defun add-msg (role content) (defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages)) (vector-push-extend (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
(defun queue-event (ev) (defun queue-event (ev)

19
lisp/gateway-tui-view.lisp
View File

@@ -44,17 +44,17 @@ Returns list of trimmed strings. Single words wider than width are split."
(clear win) (clear win)
(box win 0 0) (box win 0 0)
(let* ((w (or (width win) 78)) (let* ((w (or (width win) 78))
(msgs (reverse (st :messages))) (msgs (st :messages))
(total (length msgs))
(max-lines (- h 2)) (max-lines (- h 2))
(y 1)) (y 1))
;; Count visible messages from end, accounting for word wrap ;; Count visible messages from end, accounting for word wrap
(let* ((msg-count 0) (let* ((msg-count 0)
(lines-remaining max-lines)) (lines-remaining max-lines))
;; Walk from most recent backwards, counting wrapped lines (loop for i from (1- total) downto 0
(let ((visible-msgs (reverse msgs))) while (> lines-remaining 0)
(loop for msg in visible-msgs do (let* ((msg (aref msgs i))
while (> lines-remaining 0) (role (getf msg :role))
do (let* ((role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
@@ -65,12 +65,11 @@ Returns list of trimmed strings. Single words wider than width are split."
(progn (decf lines-remaining nlines) (incf msg-count)) (progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0)))) (setf lines-remaining 0))))
;; Render from the correct starting message ;; Render from the correct starting message
(let* ((total (length msgs)) (let* ((scroll-skip (st :scroll-offset))
(scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip)))) (start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total (loop for i from start below total
while (< y (1- h)) while (< y (1- h))
do (let* ((msg (nth i msgs)) do (let* ((msg (aref msgs i))
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
@@ -81,7 +80,7 @@ Returns list of trimmed strings. Single words wider than width are split."
(dolist (line wrapped) (dolist (line wrapped)
(when (< y (1- h)) (when (< y (1- h))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color) (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y))))))))) (incf y))))))))
(refresh win)) (refresh win))
(defun view-input (win) (defun view-input (win)

132
org/gateway-tui-main.org
View File

@@ -116,7 +116,23 @@ Event handlers + daemon I/O + main loop.
(progn (funcall 'unfocus) (progn (funcall 'unfocus)
(add-msg :system "Popped context")) (add-msg :system "Popped context"))
(add-msg :system "Context manager not loaded"))) (add-msg :system "Context manager not loaded")))
;; Normal message ;; /quit — save history and exit
((or (string-equal text "/quit") (string-equal text "/q"))
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
(user-homedir-pathname))))
(uiop:ensure-all-directories-exist (list hist-file))
(with-open-file (out hist-file :direction :output
:if-exists :supersede :if-does-not-exist :create)
(dolist (entry (reverse (st :input-history)))
(write-line entry out))))
(add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil))
;; /reconnect — re-establish daemon connection
((string-equal text "/reconnect")
(disconnect-daemon)
(connect-daemon))
;; Normal message
(t (t
(add-msg :user text) (add-msg :user text)
(setf (st :busy) t) (setf (st :busy) t)
@@ -155,31 +171,32 @@ Event handlers + daemon I/O + main loop.
(incf (st :cursor-pos)) (incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (st :dirty) (list nil nil t))))
;; Up arrow ;; Up arrow
((or (eq ch :up) (eql ch 259)) ((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos))) (let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h)))) (when (and h (< p (1- (length h))))
(incf (st :input-hpos)) (incf (st :input-hpos))
(setf (st :input-buffer) (setf (st :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list))) (reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (st :dirty) (list nil nil t)))))
;; Down arrow ;; Down arrow
((or (eq ch :down) (eql ch 258)) ((or (eq ch :down) (eql ch 258))
(when (> (st :input-hpos) 0) (when (> (st :input-hpos) 0)
(decf (st :input-hpos)) (decf (st :input-hpos))
(let ((h (st :input-history))) (let ((h (st :input-history)))
(setf (st :input-buffer) (setf (st :input-buffer)
(if (and h (< (st :input-hpos) (length h))) (if (and h (< (st :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list)) (reverse (coerce (nth (st :input-hpos) h) 'list))
nil)) nil))
(setf (st :dirty) (list nil nil t))))) (setf (st :dirty) (list nil nil t)))))
;; PageUp ;; PageUp
((or (eq ch :ppage) (eql ch 339)) ((or (eq ch :ppage) (eql ch 339))
(incf (st :scroll-offset) 5) (let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :dirty) (list nil t nil))) (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
;; PageDown (setf (st :dirty) (list nil t nil)))
((or (eq ch :npage) (eql ch 338)) ;; PageDown
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5))) ((or (eq ch :npage) (eql ch 338))
(setf (st :dirty) (list nil t nil))) (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable ;; Printable
(t (t
(let ((chr (typecase ch (let ((chr (typecase ch
@@ -232,11 +249,28 @@ Event handlers + daemon I/O + main loop.
(error () nil))) (error () nil)))
(defun reader-loop (s) (defun reader-loop (s)
(loop while (and (st :running) (open-stream-p s)) (let ((consecutive-nils 0))
do (let ((msg (recv-daemon s))) (loop while (and (st :running) (open-stream-p s))
(if msg do (let ((msg (recv-daemon s)))
(queue-event (list :type :daemon :payload msg)) (if msg
(sleep 0.5))))) (progn (queue-event (list :type :daemon :payload msg))
(setf consecutive-nils 0))
(progn (sleep 0.5)
(incf consecutive-nils)
(when (> consecutive-nils 10)
(queue-event (list :type :disconnected))
(return))))))))
(defun load-history ()
"Load input history from disk on TUI startup."
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
(user-homedir-pathname))))
(when (uiop:file-exists-p hist-file)
(with-open-file (in hist-file :direction :input)
(loop for line = (read-line in nil nil)
while line
do (push line (st :input-history))))
(setf (st :input-history) (nreverse (st :input-history))))))
#+end_src #+end_src
** Connection ** Connection
@@ -276,6 +310,7 @@ Event handlers + daemon I/O + main loop.
#+begin_src lisp #+begin_src lisp
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil) (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24)) (let* ((h (or (height scr) 24))
(w (or (width scr) 80)) (w (or (width scr) 80))
@@ -288,7 +323,9 @@ Event handlers + daemon I/O + main loop.
4006))) 4006)))
(setf (function-keys-enabled-p iw) t (setf (function-keys-enabled-p iw) t
(input-blocking iw) nil (input-blocking iw) nil
(st :dirty) (list t t t)) (st :dirty) (list t t t)
;; Store windows in state for SIGWINCH handler
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
(connect-daemon) (connect-daemon)
(when (> swank-port 0) (when (> swank-port 0)
(handler-case (handler-case
@@ -306,11 +343,34 @@ Event handlers + daemon I/O + main loop.
(refresh scr) (refresh scr)
(loop while (st :running) do (loop while (st :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
(when (eq (getf ev :type) :daemon) (cond
(on-daemon-msg (getf ev :payload)))) ((eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload)))
((eq (getf ev :type) :disconnected)
(setf (st :connected) nil
(st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
(let ((ch (get-char iw))) (let ((ch (get-char iw)))
(when (and ch (not (equal ch -1))) (cond
(on-key ch))) ((or (not ch) (equal ch -1)) nil)
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
((eql ch 410)
(let* ((new-h (or (height scr) 24))
(new-w (or (width scr) 80))
(new-ch (- new-h 5)))
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
ch new-ch
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
w new-w
h new-h)
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
(st :sw) sw (st :cw) cw (st :iw) iw)
(redraw sw cw ch iw)
(refresh scr)))
(t (on-key ch))))
(redraw sw cw ch iw) (redraw sw cw ch iw)
(refresh scr) (refresh scr)
(sleep 0.03)) (sleep 0.03))

5
org/gateway-tui-model.org
View File

@@ -48,7 +48,8 @@ All state mutation flows through event handlers in the controller.
(setf *state* (setf *state*
(list :running t :mode :chat :connected nil :stream nil (list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0 :input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :busy nil :cursor-pos 0 :messages (make-array 16 :adjustable t :fill-pointer 0)
:scroll-offset 0 :busy nil :cursor-pos 0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
#+end_src #+end_src
@@ -82,7 +83,7 @@ All state mutation flows through event handlers in the controller.
(setf (st :cursor-pos) (1- pos)))))) (setf (st :cursor-pos) (1- pos))))))
(defun add-msg (role content) (defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages)) (vector-push-extend (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
#+end_src #+end_src

19
org/gateway-tui-view.org
View File

@@ -69,17 +69,17 @@ Returns list of trimmed strings. Single words wider than width are split."
(clear win) (clear win)
(box win 0 0) (box win 0 0)
(let* ((w (or (width win) 78)) (let* ((w (or (width win) 78))
(msgs (reverse (st :messages))) (msgs (st :messages))
(total (length msgs))
(max-lines (- h 2)) (max-lines (- h 2))
(y 1)) (y 1))
;; Count visible messages from end, accounting for word wrap ;; Count visible messages from end, accounting for word wrap
(let* ((msg-count 0) (let* ((msg-count 0)
(lines-remaining max-lines)) (lines-remaining max-lines))
;; Walk from most recent backwards, counting wrapped lines (loop for i from (1- total) downto 0
(let ((visible-msgs (reverse msgs))) while (> lines-remaining 0)
(loop for msg in visible-msgs do (let* ((msg (aref msgs i))
while (> lines-remaining 0) (role (getf msg :role))
do (let* ((role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
@@ -90,12 +90,11 @@ Returns list of trimmed strings. Single words wider than width are split."
(progn (decf lines-remaining nlines) (incf msg-count)) (progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0)))) (setf lines-remaining 0))))
;; Render from the correct starting message ;; Render from the correct starting message
(let* ((total (length msgs)) (let* ((scroll-skip (st :scroll-offset))
(scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip)))) (start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total (loop for i from start below total
while (< y (1- h)) while (< y (1- h))
do (let* ((msg (nth i msgs)) do (let* ((msg (aref msgs i))
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
@@ -106,7 +105,7 @@ Returns list of trimmed strings. Single words wider than width are split."
(dolist (line wrapped) (dolist (line wrapped)
(when (< y (1- h)) (when (< y (1- h))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color) (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y))))))))) (incf y))))))))
(refresh win)) (refresh win))
#+end_src #+end_src