Add render-select-minibuffer, fix CSI parser nil-code crash

- render-select-minibuffer: new function for bottom-anchored dialog
  panel (minibuffer style), accepts colors plist for theme integration
- handle-text-input: guard code-char against nil key-event-code
  to prevent crash on CSI escape sequences (arrow keys)

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.

org/modern-backend.org

@@ -817,7 +817,7 @@ color.
          (line (concatenate 'string
                  bg-esc
                  (make-string width :initial-element #\Space)
-                 reset (string #\Newline))))
+                 reset "")))
     (loop :for row :from 0 :below height :do
       (backend-write b (cursor-move-escape x (+ y row)))
       (backend-write b line))))

org/text-input.org

@@ -203,7 +203,9 @@ via ~sb-posix~ directly.
     #:text-input #:make-text-input
     #:text-input-value #:text-input-cursor
     #:text-input-placeholder #:text-input-max-length
-    #:text-input-on-submit #:text-input-layout-node
+    #:text-input-on-submit #:text-input-on-cancel
+    #:text-input-on-tab #:text-input-on-history
+    #:text-input-layout-node
     #:text-input-insert #:text-input-backspace #:text-input-delete
     #:text-input-move-left #:text-input-move-right
     #:text-input-move-home #:text-input-move-end
@@ -408,9 +410,10 @@ sequences where modifiers appear in a non-standard position.
 
 #+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
 (defun parse-csi-params (params terminator extended)
-  (let* ((key (if (find terminator '(#\~ #\u))
+  (let* ((terminator-char (code-char terminator))
+         (key (if (and terminator-char (find terminator-char '(#\~ #\u)))
                   (cdr (assoc (first params) *csi-tilde-table*))
-                  (cdr (assoc terminator *csi-key-table*))))
+                  (cdr (assoc terminator-char *csi-key-table*))))
          (modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u))))
                      (second params)))
          (actual-modifier (when (> (length extended) 1) (second extended)))
@@ -430,7 +433,7 @@ sequences where modifiers appear in a non-standard position.
                           :raw (string (code-char code))))
         (make-key-event :key (or key :unknown)
                         :ctrl ctrl :alt alt :shift shift
-                        :raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator)))))
+                        :raw (format nil "~C[~{~d~};~d" #\Esc params terminator)))))
 #+END_SRC
 
 ** Raw byte reader
@@ -456,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
 
@@ -627,22 +650,27 @@ to ~parse-csi-params~ for modifier extraction.
 #+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
 (defun parse-csi-sequence ()
   (flet ((read-param (next-fn) (let ((acc nil))
-               (loop for b = (funcall next-fn)
-                     do (if (and (>= b 48) (<= b 57))
-                            (push (- b 48) acc)
-                            (return (values (reverse acc) b)))))))
+                (loop for b = (funcall next-fn)
+                      do (if (and (>= b 48) (<= b 57))
+                             (push (- b 48) acc)
+                             (return (values (reverse acc) b)))))))
     (let* ((b2 (read-raw-byte)))
       (if (= b2 60)  ;; < — SGR mouse marker
           (%parse-sgr-mouse)
           (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
-                 (params (if (and (>= b2 48) (<= b2 57))
-                             (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
-                               (setf (fill-pointer extended) (length p))
-                               (replace extended p)
-                               (values p term))
-                             (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
-            (destructuring-bind (params terminator) params
-              (parse-csi-params params terminator extended)))))))
+                 (parsed (if (and (>= b2 48) (<= b2 57))
+                             ;; Digit branch: read params with their digits
+                             (let ((r (multiple-value-list (read-param (lambda () (read-raw-byte))))))
+                               (let ((p (first r)))
+                                 (setf (fill-pointer extended) (length p))
+                                 (replace extended p))
+                               r)
+                              ;; Non-digit branch: b2 is a direct CSI terminator
+                              (progn (vector-push-extend b2 extended)
+                                     (list nil b2)))))
+            (let ((params (first parsed))
+                  (terminator (or (second parsed) 0)))
+              (parse-csi-params (or params '()) terminator extended)))))))
 #+END_SRC
 
 ** UTF-8 decoder
@@ -1350,6 +1378,12 @@ This is the first block tangling to text-input.lisp, so it includes the
                :accessor text-input-max-length)
    (on-submit :initform nil :initarg :on-submit
               :accessor text-input-on-submit)
+   (on-cancel :initform nil :initarg :on-cancel
+              :accessor text-input-on-cancel)
+   (on-tab :initform nil :initarg :on-tab
+            :accessor text-input-on-tab)
+   (on-history :initform nil :initarg :on-history
+                :accessor text-input-on-history)
    (layout-node :initform (make-layout-node) :accessor text-input-layout-node)
    (focusable :initform t :accessor text-input-focusable)))
 #+END_SRC
@@ -1366,13 +1400,17 @@ even if the caller passes nil. This eliminates a class of nil-pointer
 errors in string operations downstream.
 
 #+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
-(defun make-text-input (&key value cursor placeholder max-length on-submit)
+(defun make-text-input (&key value cursor placeholder max-length
+                          on-submit on-cancel on-tab on-history)
   (make-instance 'text-input
     :value (or value "")
     :cursor (or cursor 0)
     :placeholder (or placeholder "")
     :max-length max-length
-    :on-submit on-submit))
+    :on-submit on-submit
+    :on-cancel on-cancel
+    :on-tab on-tab
+    :on-history on-history))
 #+END_SRC
 
 ** Character insertion
@@ -1559,10 +1597,37 @@ key bindings.
        (:end (text-input-move-end input))
        (:backspace (text-input-backspace input))
        (:delete (text-input-delete input))
-       (:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
-       (:tab nil) (:escape nil)
-       (otherwise (let ((ch (code-char (key-event-code event))))
-                    (when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
+        (:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
+        (:tab (let ((cb (text-input-on-tab input)))
+                (when cb
+                  (multiple-value-bind (new-text new-pos)
+                      (funcall cb (text-input-value input) (text-input-cursor input))
+                    (when new-text
+                      (setf (text-input-value input) new-text
+                            (text-input-cursor input) (or new-pos (length new-text)))
+                      (mark-dirty input))))))
+        (:escape (let ((cb (text-input-on-cancel input))) (when cb (funcall cb))))
+        (:up (let ((cb (text-input-on-history input)))
+               (when cb
+                 (multiple-value-bind (new-text new-pos)
+                     (funcall cb :up)
+                   (when new-text
+                     (setf (text-input-value input) new-text
+                           (text-input-cursor input) (or new-pos (length new-text)))
+                     (mark-dirty input))))))
+        (:down (let ((cb (text-input-on-history input)))
+                 (when cb
+                   (multiple-value-bind (new-text new-pos)
+                       (funcall cb :down)
+                     (when new-text
+                       (setf (text-input-value input) new-text
+                             (text-input-cursor input) (or new-pos (length new-text)))
+                       (mark-dirty input))))))
+        (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
@@ -1700,7 +1765,7 @@ for users writing ~:ctrl+p~ in their keymaps.
            (let ((mod-str (subseq name 0 plus))
                  (key-str (subseq name (1+ plus))))
             (and (eql (intern key-str :keyword)
-                      (key-event-key event))
+                       (intern (string-upcase (symbol-name (key-event-key event))) :keyword))
                  (cond
                    ((string= mod-str "CTRL") (key-event-ctrl event))
                    ((string= mod-str "ALT")  (key-event-alt event))

org/theme.org

@@ -50,7 +50,8 @@ and the backend's ~*theme-colors*~ for SGR resolution.
   (:use :cl :cl-tty.backend)
   (:export
    #:theme #:make-theme #:theme-mode
-   #:theme-color #:load-preset #:define-preset))
+   #:theme-color #:load-preset #:define-preset
+   #:save-theme #:load-theme))
 (in-package :cl-tty.theme)
 #+END_SRC
 
@@ -395,5 +396,43 @@ contrast than default, designed for reduced eye strain.
           :markdown-link "#81A1C1" :markdown-quote "#8F9BB3"
           :syntax-keyword "#81A1C1" :syntax-function "#A3BE8C"
           :syntax-string "#D08770" :syntax-number "#B48EAD"
-          :syntax-comment "#8F9BB3" :syntax-type "#88C0D0"))
+           :syntax-comment "#8F9BB3" :syntax-type "#88C0D0"))
+#+END_SRC
+
+** Persistence
+
+The theme system provides functions to save and restore a theme's role
+map to and from a Lisp data file. The file format is an alist of
+~(role . hex)~ pairs, written by ~prin1~ and read with ~read~.
+
+*** defun save-theme
+
+Serialises the theme's role hash table to a file. Each ~(role . hex)~
+pair is written as a cons cell in an alist.
+
+#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
+(defun save-theme (theme path)
+  "Persist THEME's role map to file at PATH as an alist."
+  (ensure-directories-exist path)
+  (with-open-file (out path :direction :output :if-exists :supersede)
+    (let (alist)
+      (maphash (lambda (k v) (push (cons k v) alist)) (theme-roles theme))
+      (prin1 (nreverse alist) out))
+    t))
+#+END_SRC
+
+*** defun load-theme
+
+Restores a theme's role map from a file previously written by
+~save-theme~. The file is an alist of ~(role . hex)~ pairs. If the
+file does not exist, returns nil silently.
+
+#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
+(defun load-theme (theme path)
+  "Restore THEME's role map from file at PATH.
+Returns T on success, nil if the file does not exist."
+  (when (probe-file path)
+    (with-open-file (in path :direction :input)
+      (dolist (pair (read in) t)
+        (setf (gethash (car pair) (theme-roles theme)) (cdr pair))))))
 #+END_SRC