add text-input callback slots (on-cancel, on-tab, on-history), update XDG .asd
This commit is contained in:
@@ -203,7 +203,9 @@ via ~sb-posix~ directly.
|
|||||||
#:text-input #:make-text-input
|
#:text-input #:make-text-input
|
||||||
#:text-input-value #:text-input-cursor
|
#:text-input-value #:text-input-cursor
|
||||||
#:text-input-placeholder #:text-input-max-length
|
#: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-insert #:text-input-backspace #:text-input-delete
|
||||||
#:text-input-move-left #:text-input-move-right
|
#:text-input-move-left #:text-input-move-right
|
||||||
#:text-input-move-home #:text-input-move-end
|
#:text-input-move-home #:text-input-move-end
|
||||||
@@ -1356,6 +1358,12 @@ This is the first block tangling to text-input.lisp, so it includes the
|
|||||||
:accessor text-input-max-length)
|
:accessor text-input-max-length)
|
||||||
(on-submit :initform nil :initarg :on-submit
|
(on-submit :initform nil :initarg :on-submit
|
||||||
:accessor text-input-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)
|
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
|
||||||
(focusable :initform t :accessor text-input-focusable)))
|
(focusable :initform t :accessor text-input-focusable)))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
@@ -1372,13 +1380,17 @@ even if the caller passes nil. This eliminates a class of nil-pointer
|
|||||||
errors in string operations downstream.
|
errors in string operations downstream.
|
||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
#+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
|
(make-instance 'text-input
|
||||||
:value (or value "")
|
:value (or value "")
|
||||||
:cursor (or cursor 0)
|
:cursor (or cursor 0)
|
||||||
:placeholder (or placeholder "")
|
:placeholder (or placeholder "")
|
||||||
:max-length max-length
|
: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
|
#+END_SRC
|
||||||
|
|
||||||
** Character insertion
|
** Character insertion
|
||||||
@@ -1565,10 +1577,34 @@ key bindings.
|
|||||||
(:end (text-input-move-end input))
|
(:end (text-input-move-end input))
|
||||||
(:backspace (text-input-backspace input))
|
(:backspace (text-input-backspace input))
|
||||||
(:delete (text-input-delete input))
|
(:delete (text-input-delete input))
|
||||||
(:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
|
(:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
|
||||||
(:tab nil) (:escape nil)
|
(:tab (let ((cb (text-input-on-tab input)))
|
||||||
(otherwise (let ((ch (code-char (key-event-code event))))
|
(when cb
|
||||||
(when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
|
(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 ((ch (code-char (key-event-code event))))
|
||||||
|
(when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
** Text input rendering
|
** Text input rendering
|
||||||
|
|||||||
Reference in New Issue
Block a user