a294f21c70
CRITICAL: Remove (declare (ignore w)) from textarea render (textarea.lisp:251) w is used for horizontal truncation on the next line. Declaring it ignored while using it is undefined behavior in CL (SBCL warns). HIGH: hit-test recurses into children (mouse.lisp:18-34) Was returning the root component for any click within its bounds, ignoring nested widgets entirely. Now checks component-children first, returning the deepest match. MEDIUM: Select/TabBar position hardcoded to (0,0) Both rendered at terminal origin regardless of layout position. Now read layout-node-x/y for absolute positioning. MEDIUM: Text-input truncation missing Render drew full value string even when exceeding widget width. Now truncates to (min (length display) w). MEDIUM: X10 mouse release detection added (input.lisp:219-226) X10 encoding uses button=3 for release. Was detecting all events as press/drag. Now checks button=3 → :release. MEDIUM: parse-csi-params handles private markers (input.lisp:128-131) < = > ? characters (0x3c-0x3f) treated as parameter start markers instead of accumulating bogus digit values. Latent trap removed. Deferred (pre-existing design): - Scrollbox visibility cy vs orig-y: match for column layout (common case) - Nested scrollbox coordinates: assumes sequential layout positions - text-input cursor drawing: feature, not bugfix 392 tests pass.
97 lines
4.7 KiB
Common Lisp
97 lines
4.7 KiB
Common Lisp
(in-package #:cl-tty.select)
|
|
|
|
(defclass select (dirty-mixin)
|
|
((options :initform nil :initarg :options :accessor select-options :type list)
|
|
(filter :initform nil :initarg :filter :accessor select-filter :type (or string null))
|
|
(selected-index :initform 0 :initarg :selected-index :accessor select-selected-index :type fixnum)
|
|
(on-select :initform nil :initarg :on-select :accessor select-on-select)
|
|
(layout-node :initform (make-layout-node) :initarg :layout-node :accessor select-layout-node)))
|
|
|
|
(defun make-select (&key options filter on-select)
|
|
(make-instance 'select :options (or options nil) :filter filter :on-select on-select))
|
|
|
|
(defmethod component-layout-node ((sel select)) (select-layout-node sel))
|
|
|
|
(defun select-filtered-options (sel)
|
|
(let* ((filter (select-filter sel)) (all-options (select-options sel))
|
|
(filtered (if (null filter) all-options
|
|
(let ((lower (string-downcase filter)))
|
|
(remove-if-not
|
|
(lambda (opt)
|
|
(or (getf opt :category)
|
|
(let ((title (string-downcase (getf opt :title))))
|
|
(or (search lower title) (fuzzy-match-p lower title)))))
|
|
all-options)))))
|
|
(loop for opt in filtered for i from 0
|
|
collect (list i (position opt all-options) opt))))
|
|
|
|
(defun fuzzy-match-p (query target)
|
|
(let* ((q (remove-duplicates (coerce (string-downcase query) 'list)))
|
|
(tg (remove-duplicates (coerce (string-downcase target) 'list)))
|
|
(intersection (length (intersection q tg)))
|
|
(union (length (union q tg))))
|
|
(if (zerop union) nil (> (/ (float intersection) union) 0.3))))
|
|
|
|
(defun select-clamp-index (sel)
|
|
(let* ((filtered (select-filtered-options sel)) (count (length filtered)))
|
|
(if (zerop count) (setf (select-selected-index sel) 0)
|
|
(setf (select-selected-index sel) (max 0 (min (select-selected-index sel) (1- count)))))))
|
|
|
|
(defun select-next (sel)
|
|
(let* ((filtered (select-filtered-options sel)) (count (length filtered))
|
|
(current (select-selected-index sel)))
|
|
(when (plusp count)
|
|
(loop for i from 1 below count
|
|
for idx = (mod (+ current i) count)
|
|
for opt = (third (nth idx filtered))
|
|
when (not (getf opt :category))
|
|
do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
|
|
|
|
(defun select-prev (sel)
|
|
(let* ((filtered (select-filtered-options sel)) (count (length filtered))
|
|
(current (select-selected-index sel)))
|
|
(when (plusp count)
|
|
(loop for i from 1 below count
|
|
for idx = (mod (- current i) count)
|
|
for opt = (third (nth idx filtered))
|
|
when (not (getf opt :category))
|
|
do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
|
|
|
|
(defun select-handle-key (sel event)
|
|
(let ((key (key-event-key event)) (ctrl (key-event-ctrl event)))
|
|
(cond
|
|
((or (eql key :down) (and ctrl (eql key :n))) (select-next sel) t)
|
|
((or (eql key :up) (and ctrl (eql key :p))) (select-prev sel) t)
|
|
((eql key :enter)
|
|
(let* ((filtered (select-filtered-options sel)) (idx (select-selected-index sel))
|
|
(item (when (< idx (length filtered)) (third (nth idx filtered)))))
|
|
(when item (let ((cb (select-on-select sel))) (when cb (funcall cb item)))) t))
|
|
((eql key :escape) nil) (t nil))))
|
|
|
|
(defun select-visible-options (sel)
|
|
(let* ((ln (select-layout-node sel)) (height (if ln (layout-node-height ln) 80))
|
|
(filtered (select-filtered-options sel)) (sel-idx (select-selected-index sel))
|
|
(half (floor (1- height) 2)) (start (max 0 (- sel-idx half)))
|
|
(end (min (length filtered) (+ start height))))
|
|
(subseq filtered start end)))
|
|
|
|
(defmethod render ((sel select) backend)
|
|
(let* ((ln (select-layout-node sel))
|
|
(x (if ln (layout-node-x ln) 0))
|
|
(y (if ln (layout-node-y ln) 0))
|
|
(w (if ln (layout-node-width ln) 80))
|
|
(visible (select-visible-options sel)) (sel-idx (select-selected-index sel)))
|
|
(dolist (item visible)
|
|
(let* ((display-idx (first item)) (option (third item))
|
|
(title (getf option :title)) (cat (getf option :category))
|
|
(selected (eql display-idx sel-idx))
|
|
(display (if (> (length title) (1- w))
|
|
(concatenate 'string (subseq title 0 (1- w)) "…") title)))
|
|
(cond (cat (draw-text backend x y display :text-muted nil))
|
|
(selected
|
|
(draw-rect backend x y w 1 :bg :accent)
|
|
(draw-text backend x y display :background :accent))
|
|
(t (draw-text backend x y display nil nil)))
|
|
(incf y 1)))
|
|
(values)))
|