diff --git a/org/dialog.org b/org/dialog.org index 2b20cb4..789e257 100644 --- a/org/dialog.org +++ b/org/dialog.org @@ -63,8 +63,9 @@ subsystems. All public symbols are exported for user convenience. #:dialog-on-dismiss #:dialog-size #:dialog-size-pixels - #:render-dialog - #:push-dialog + #:render-dialog + #:render-select-minibuffer + #:push-dialog #:pop-dialog #:*dialog-stack* #:alert-dialog @@ -172,6 +173,58 @@ Content is rendered via ~draw-text~ inside the panel area. :white :default))))) #+END_SRC +** render-select-minibuffer + +Renders a ~select~ widget as a bottom-anchored minibuffer panel at the +given position. The panel fills a rectangular area, draws a separator +line with the title at the top, the filtered options in the middle, +and a filter input line (>= ~...~) at the bottom. ~colors~ is a plist +with keys ~:bg-panel~, ~:separator~, ~:accent~, ~:text-muted~, +~:agent-fg~, ~:input-fg~, ~:bg-input~, ~:input-prompt~. + +#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp +(defun render-select-minibuffer (be x y width height select title colors) + (let* ((filtered (select-filtered-options select)) + (sel-idx (or (select-selected-index select) 0)) + (filter (select-filter select)) + (bg-p (getf colors :bg-panel)) + (sep-c (getf colors :separator))) + (dotimes (r height) + (draw-rect be x (+ y r) width 1 :bg bg-p)) + (draw-text be x y (make-string width :initial-element #\─) sep-c bg-p) + (draw-text be (1+ x) y title (getf colors :accent) bg-p) + (loop for item in filtered + for i from 1 + for display-idx = (first item) + for option = (third item) + for opt-title = (getf option :title) + for cat = (getf option :category) + for sel-p = (eql display-idx sel-idx) + for row = (+ y i) + while (< row (+ y (min height (length filtered)))) + do (cond + (sel-p + (draw-rect be (1+ x) row (1- width) 1 + :bg (getf colors :input-fg)) + (draw-text be (1+ x) row + (format nil " >> ~a" opt-title) + (getf colors :bg-input) + (getf colors :input-fg))) + (cat + (draw-text be (1+ x) row + (format nil " ~a" opt-title) + (getf colors :text-muted) bg-p)) + (t + (draw-text be (1+ x) row + (format nil " ~a" opt-title) + (getf colors :agent-fg) bg-p)))) + (let ((filter-y (+ y (- height 3)))) + (draw-rect be x filter-y width 1 :bg bg-p) + (draw-text be x filter-y + (format nil "> ~a" (or filter "")) + (getf colors :input-prompt) bg-p)))) +#+END_SRC + ** push-dialog Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining. diff --git a/org/text-input.org b/org/text-input.org index a244e69..f4c8c7b 100644 --- a/org/text-input.org +++ b/org/text-input.org @@ -459,17 +459,37 @@ and manual ~free-alien~ while keeping the GC from moving the buffer during the ~unix-read~ syscall. #+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp +(defun get-input-fd () + "Return a file descriptor suitable for reading terminal input. + Prefers fd 0 (stdin) if it's a TTY, otherwise opens /dev/tty. + Falls back to fd 0 if /dev/tty is not available." + (or (and (sb-unix:unix-isatty 0) 0) + (handler-case + (let ((fd (sb-unix:unix-open "/dev/tty" sb-unix:o_rdonly))) + (if (and fd (>= fd 0)) fd 0)) + (error () 0)))) + (defun read-raw-byte (&key timeout) (let* ((buf (make-array 1 :element-type '(unsigned-byte 8))) - (fd 0) + (fd-stream (get-input-fd)) (timeout-ms (when timeout (max 1 (round (* timeout 1000)))))) (sb-sys:with-pinned-objects (buf) (let ((sap (sb-sys:vector-sap buf))) (if timeout-ms - (progn (sb-unix:unix-simple-poll fd :input timeout-ms) - (let ((n (sb-unix:unix-read fd sap 1))) - (if (= n 1) (aref buf 0) (values nil :eof)))) - (let ((n (sb-unix:unix-read fd sap 1))) + (let ((poll-result (sb-unix:unix-simple-poll fd-stream :input timeout-ms))) + (if poll-result + (let ((n (sb-unix:unix-read fd-stream sap 1))) + (if (= n 1) + (aref buf 0) + ;; EOF on fd — try opening /dev/tty + (let ((tty-fd (sb-unix:unix-open "/dev/tty" sb-unix:o_rdonly))) + (if (and tty-fd (>= tty-fd 0)) + (let ((m (sb-unix:unix-read tty-fd sap 1))) + (sb-unix:unix-close tty-fd) + (if (= m 1) (aref buf 0) (values nil nil))) + (values nil nil))))) + (values nil nil))) + (let ((n (sb-unix:unix-read fd-stream sap 1))) (if (= n 1) (aref buf 0) (values nil :eof)))))))) #+END_SRC @@ -1603,8 +1623,11 @@ key bindings. (setf (text-input-value input) new-text (text-input-cursor input) (or new-pos (length new-text))) (mark-dirty input)))))) - (otherwise (let ((ch (code-char (key-event-code event)))) - (when (and ch (graphic-char-p ch)) (text-input-insert input ch)))))))) + (otherwise (let ((code (key-event-code event))) + (when code + (let ((ch (code-char code))) + (when (and ch (graphic-char-p ch)) + (text-input-insert input ch)))))))))) #+END_SRC ** Text input rendering