amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Shell wrapper for terminal raw mode, demo no longer sets raw mode

Browse Source 
Added ./demo shell script that sets raw mode via stty before running
the Lisp demo and restores it on exit (including SIGINT/SIGTERM).

demo.lisp no longer attempts to set raw mode from inside SBCL —
terminal raw mode is the shell's responsibility.  This avoids the
recurring problem of sb-ext:run-program + stty not being able to
access the controlling terminal from inside sbcl --script.
This commit is contained in:
Hermes
2026-05-12 01:43:52 +00:00
parent 613e4b6217
commit 2b2119a2f1
2 changed files with 68 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
demo Executable file
View File

@@ -0,0 +1,20 @@
#!/bin/sh
# cl-tty demo launcher
# Sets raw terminal mode, runs the demo, restores terminal on exit.
# This is needed because SBCL's --script mode + run-program combo
# can't reliably set raw mode from inside the Lisp process.
SAVED=$(stty -g 2>/dev/null)
if [ -z "$SAVED" ]; then
echo "ERROR: Not running in a real terminal." >&2
echo " Try: sbcl --script demo.lisp" >&2
exit 1
fi
cleanup() {
stty "$SAVED" 2>/dev/null
}
trap cleanup EXIT INT TERM
stty raw -echo -isig -icanon min 1 time 0 2>/dev/null
sbcl --script "$(dirname "$0")/demo.lisp"

101
demo.lisp
View File

@@ -124,60 +124,55 @@
t))) t)))
(defun run-demo () (defun run-demo ()
(let ((saved (ignore-errors (set-raw-mode)))) "Run the demo. Assumes raw terminal mode is already set by the
(unless saved shell wrapper (./demo) or by running:
(format *error-output* "~&ERROR: Cannot set terminal to raw mode.~%") stty raw -echo -isig -icanon min 1 time 0
(format *error-output* " Make sure you are in a real terminal (not a pipe/redirect).~%") sbcl --script demo.lisp"
(format *error-output* " Try: sbcl --script demo.lisp~%") (init-app-state)
(return-from run-demo)) (let* ((backend (detect-backend))
(w 80) (h 24))
(declare (ignore h))
(initialize-backend backend)
(unwind-protect (unwind-protect
(progn (loop while (getf *app* :running)
(init-app-state) do
(let* ((backend (detect-backend)) (backend-clear backend)
(w 80) (h 24)) ;; Title bar
(initialize-backend backend) (draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
(unwind-protect (draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR q/esc: quit"
(loop while (getf *app* :running) :bright-white nil)
do ;; Tab bar
(backend-clear backend) (loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
;; Title bar for x-pos = 4 then (+ x-pos label-len 2)
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ") for label-len = (length label)
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR q/esc: quit" do (let ((active (eql idx (getf *app* :tab))))
:bright-white nil) (if active
;; Tab bar (draw-text backend x-pos 4 label :bright-white :accent :bold t)
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2)) (draw-text backend x-pos 4 label :text-muted nil))))
for x-pos = 4 then (+ x-pos label-len 2) ;; Content area
for label-len = (length label) (case (getf *app* :tab)
do (let ((active (eql idx (getf *app* :tab)))) (0 (render-tab-home backend 4 6 72 20))
(if active (1 (render-tab-widgets backend 4 6 72 24
(draw-text backend x-pos 4 label :bright-white :accent :bold t) (getf *app* :input)
(draw-text backend x-pos 4 label :text-muted nil)))) (getf *app* :textarea)))
;; Content area (2 (render-tab-console backend 4 6 72 16)))
(case (getf *app* :tab) ;; Mouse cursor indicator
(0 (render-tab-home backend 4 6 72 20)) (let ((mx (getf *app* :mouse-x))
(1 (render-tab-widgets backend 4 6 72 24 (my (getf *app* :mouse-y)))
(getf *app* :input) (when (and (>= mx 0) (>= my 0))
(getf *app* :textarea))) (draw-text backend mx my "@" :bright-cyan nil)))
(2 (render-tab-console backend 4 6 72 16))) ;; Status bar
;; Mouse cursor indicator (draw-rect backend 2 23 (- w 4) 1 :bg :blue)
(let ((mx (getf *app* :mouse-x)) (draw-text backend 4 23
(my (getf *app* :mouse-y))) (format nil " Tab ~d/3 | ~d events "
(when (and (>= mx 0) (>= my 0)) (1+ (getf *app* :tab)) (length *log*))
(draw-text backend mx my "@" :bright-cyan nil))) :bright-white :blue :bold t)
;; Status bar (finish-output *standard-output*)
(draw-rect backend 2 23 (- w 4) 1 :bg :blue) ;; Read event — blocks until a key or mouse event arrives
(draw-text backend 4 23 (let ((event (read-event backend)))
(format nil " Tab ~d/3 | ~d events " (when event
(1+ (getf *app* :tab)) (length *log*)) (handle-event event))))
:bright-white :blue :bold t) (shutdown-backend backend))))
(finish-output *standard-output*)
;; Read event — blocks until a key or mouse event arrives
(let ((event (read-event backend)))
(when event
(handle-event event))))
(shutdown-backend backend))))
(when saved
(restore-terminal-state saved)))))
(run-demo) (run-demo)
(uiop:quit 0) (uiop:quit 0)