(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))) (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)))