fix: input timeout bugs — read-raw-byte, SS3, parse-csi-params all use sub-second timeouts now (get-internal-real-time replaces get-universal-time which truncated to integer seconds)
This commit is contained in:
Hermes Agent
@@ -1,7 +1,7 @@
|
||||
;;; dialog-package.lisp — Package definition for cl-tty.dialog
|
||||
|
||||
(defpackage :cl-tty.dialog
|
||||
(:use :cl :cl-tty.input :cl-tty.select)
|
||||
(:use :cl :cl-tty.backend :cl-tty.input :cl-tty.select)
|
||||
(:export
|
||||
#:dialog
|
||||
#:dialog-title
|
||||
|
||||
BIN
src/components/input.fasl
Normal file
BIN
src/components/input.fasl
Normal file
Binary file not shown.
@@ -96,8 +96,10 @@ Returns:
|
||||
((plusp n) (return-from read-raw-byte (aref buf 0)))
|
||||
((zerop n) (return-from read-raw-byte (values nil :eof)))))))))
|
||||
(if timeout
|
||||
(let ((deadline (+ (get-universal-time) timeout)))
|
||||
(loop while (< (get-universal-time) deadline)
|
||||
(let* ((start (get-internal-real-time))
|
||||
(ticks (round (* timeout internal-time-units-per-second)))
|
||||
(deadline (+ start ticks)))
|
||||
(loop while (< (get-internal-real-time) deadline)
|
||||
do (handler-case
|
||||
(read-one)
|
||||
(sb-posix:syscall-error ()
|
||||
@@ -113,18 +115,18 @@ Returns:
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; CSI parameter parser
|
||||
;;; ---------------------------------------------------------------------------
|
||||
(defun parse-csi-params ()
|
||||
(defun parse-csi-params (&key timeout)
|
||||
(let ((params '())
|
||||
(raw (make-array 0 :element-type '(unsigned-byte 8)
|
||||
:fill-pointer 0 :adjustable t))
|
||||
(current 0))
|
||||
(loop
|
||||
(multiple-value-bind (b reason) (read-raw-byte)
|
||||
(multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
|
||||
(unless b
|
||||
(return-from parse-csi-params
|
||||
(if (eq reason :eof)
|
||||
(values nil nil :eof)
|
||||
(values nil nil nil))))
|
||||
(values nil nil :timeout))))
|
||||
(vector-push-extend b raw)
|
||||
(cond
|
||||
((and (>= b #x30) (<= b #x3f))
|
||||
@@ -205,86 +207,84 @@ key event rather than blocking indefinitely."
|
||||
(return-from %read-escape-sequence
|
||||
(if (eq reason :eof) :eof
|
||||
(make-key-event :key :escape :raw (string #\Esc)))))
|
||||
(case b
|
||||
(if (eql b #x4f)
|
||||
;; SS3: ESC O X
|
||||
(#x4f
|
||||
(let ((b2 (read-raw-byte)))
|
||||
(if b2
|
||||
(let ((key (cdr (assoc (code-char b2)
|
||||
'((#\P . :f1) (#\Q . :f2)
|
||||
(#\R . :f3) (#\S . :f4))))))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
|
||||
:eof)))
|
||||
;; CSI: ESC [ ...
|
||||
(#x5b
|
||||
(multiple-value-bind (params final-byte raw) (parse-csi-params)
|
||||
(cond
|
||||
((null final-byte)
|
||||
;; EOF during CSI parsing — propagate it
|
||||
(if (eq raw :eof)
|
||||
:eof
|
||||
(make-key-event :key :escape :raw (string #\Esc))))
|
||||
;; SGR mouse: ESC [ < ... m/M
|
||||
((and raw (plusp (length raw)) (char= (char raw 0) #\<))
|
||||
(or (parse-sgr-mouse raw)
|
||||
(make-key-event :key :unknown :raw raw)))
|
||||
((and (char= (code-char final-byte) #\M)
|
||||
(>= (length params) 3))
|
||||
(let* ((p0 (first params)))
|
||||
(if (zerop (logand p0 #x40))
|
||||
(let* ((x (second params))
|
||||
(y (third params))
|
||||
(button (logand p0 #x03))
|
||||
(motion (logand p0 #x20))
|
||||
(release (= button 3)))
|
||||
(make-mouse-event
|
||||
:type (cond (release :release)
|
||||
(motion :drag)
|
||||
(t :press))
|
||||
:button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
|
||||
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
|
||||
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
||||
(param (or p0 0))
|
||||
(key (if tilde-p
|
||||
(cdr (assoc param *csi-tilde-table*))
|
||||
(cdr (assoc (code-char final-byte) *csi-key-table*))))
|
||||
(modifier (when (> (length params) 1) (second params))))
|
||||
(let ((ctrl nil) (alt nil) (shift nil))
|
||||
(when modifier
|
||||
(setf shift (logtest modifier 1)
|
||||
alt (logtest modifier 2)
|
||||
ctrl (logtest modifier 4)))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:ctrl ctrl :alt alt :shift shift
|
||||
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))
|
||||
(t
|
||||
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
||||
(param (or (first params) 0))
|
||||
(key (if tilde-p
|
||||
(cdr (assoc param *csi-tilde-table*))
|
||||
(cdr (assoc (code-char final-byte) *csi-key-table*))))
|
||||
(modifier (when (> (length params) 1) (second params))))
|
||||
(let ((ctrl nil) (alt nil) (shift nil))
|
||||
(when modifier
|
||||
(setf shift (logtest modifier 1)
|
||||
alt (logtest modifier 2)
|
||||
ctrl (logtest modifier 4)))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:ctrl ctrl :alt alt :shift shift
|
||||
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))))))
|
||||
;; ESC ESC
|
||||
(#x1b
|
||||
(make-key-event :key :escape :alt t :raw "\\e\\e"))
|
||||
;; ESC + printable = Alt+key
|
||||
(t
|
||||
(let ((ch (code-char b)))
|
||||
(if (and (>= b #x20) (<= b #x7e))
|
||||
(make-key-event :key (intern (string (string-upcase ch)) :keyword)
|
||||
:alt t
|
||||
:raw (format nil "~C~C" #\Esc ch))
|
||||
(make-key-event :key :unknown
|
||||
:raw (format nil "~C~C" #\Esc ch))))))))
|
||||
(multiple-value-bind (b2 reason) (read-raw-byte :timeout 0.1)
|
||||
(if b2
|
||||
(let ((key (cdr (assoc (code-char b2)
|
||||
'((#\P . :f1) (#\Q . :f2)
|
||||
(#\R . :f3) (#\S . :f4))))))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
|
||||
(make-key-event :key :escape :raw (string #\Esc))))
|
||||
(if (eql b #x5b)
|
||||
;; CSI: ESC [ ...
|
||||
(multiple-value-bind (params final-byte raw) (parse-csi-params :timeout 0.5)
|
||||
(cond
|
||||
((null final-byte)
|
||||
;; EOF during CSI parsing — propagate it
|
||||
(if (eq raw :eof)
|
||||
:eof
|
||||
(make-key-event :key :escape :raw (string #\Esc))))
|
||||
;; SGR mouse: ESC [ < ... m/M
|
||||
((and raw (plusp (length raw)) (char= (char raw 0) #\<))
|
||||
(or (parse-sgr-mouse raw)
|
||||
(make-key-event :key :unknown :raw raw)))
|
||||
((and (char= (code-char final-byte) #\M)
|
||||
(>= (length params) 3))
|
||||
(let* ((p0 (first params)))
|
||||
(if (zerop (logand p0 #x40))
|
||||
(let* ((x (second params))
|
||||
(y (third params))
|
||||
(button (logand p0 #x03))
|
||||
(motion (logand p0 #x20))
|
||||
(release (= button 3)))
|
||||
(make-mouse-event
|
||||
:type (cond (release :release)
|
||||
(motion :drag)
|
||||
(t :press))
|
||||
:button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
|
||||
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
|
||||
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
||||
(param (or p0 0))
|
||||
(key (if tilde-p
|
||||
(cdr (assoc param *csi-tilde-table*))
|
||||
(cdr (assoc (code-char final-byte) *csi-key-table*))))
|
||||
(modifier (when (> (length params) 1) (second params))))
|
||||
(let ((ctrl nil) (alt nil) (shift nil))
|
||||
(when modifier
|
||||
(setf shift (logtest modifier 1)
|
||||
alt (logtest modifier 2)
|
||||
ctrl (logtest modifier 4)))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:ctrl ctrl :alt alt :shift shift
|
||||
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))
|
||||
(t
|
||||
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
||||
(param (or (first params) 0))
|
||||
(key (if tilde-p
|
||||
(cdr (assoc param *csi-tilde-table*))
|
||||
(cdr (assoc (code-char final-byte) *csi-key-table*))))
|
||||
(modifier (when (> (length params) 1) (second params))))
|
||||
(let ((ctrl nil) (alt nil) (shift nil))
|
||||
(when modifier
|
||||
(setf shift (logtest modifier 1)
|
||||
alt (logtest modifier 2)
|
||||
ctrl (logtest modifier 4)))
|
||||
(make-key-event :key (or key :unknown)
|
||||
:ctrl ctrl :alt alt :shift shift
|
||||
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))
|
||||
(if (eql b #x1b)
|
||||
;; ESC ESC
|
||||
(make-key-event :key :escape :alt t :raw "\\e\\e")
|
||||
;; ESC + printable = Alt+key
|
||||
(let ((ch (code-char b)))
|
||||
(if (and (>= b #x20) (<= b #x7e))
|
||||
(make-key-event :key (intern (string (string-upcase ch)) :keyword)
|
||||
:alt t
|
||||
:raw (format nil "~C~C" #\Esc ch))
|
||||
(make-key-event :key :unknown
|
||||
:raw (format nil "~C~C" #\Esc ch)))))))))
|
||||
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Top-level event reader
|
||||
|
||||
@@ -140,7 +140,6 @@
|
||||
i)))
|
||||
|
||||
(defun parse-list (lines start)
|
||||
(declare (ignore start))
|
||||
(let ((items nil) (i start))
|
||||
(loop while (< i (length lines))
|
||||
do (let* ((raw-line (aref lines i))
|
||||
|
||||
@@ -47,6 +47,7 @@ Children outside the viewport are skipped."
|
||||
(vh (if ln (layout-node-height ln) 24))
|
||||
(sy (scroll-box-scroll-y sb))
|
||||
(sx (scroll-box-scroll-x sb)))
|
||||
(declare (ignore vx))
|
||||
(dolist (child (scroll-box-children sb))
|
||||
(let* ((cln (component-layout-node child))
|
||||
(ch (if cln (layout-node-height cln) 1))
|
||||
|
||||
@@ -167,5 +167,5 @@
|
||||
value
|
||||
(or (text-input-placeholder in) "")))
|
||||
(truncated (subseq display 0 (min (length display) w))))
|
||||
(declare (ignore w cursor))
|
||||
(declare (ignore cursor))
|
||||
(draw-text backend x y truncated nil nil)))
|
||||
|
||||
Binary file not shown.
@@ -92,6 +92,7 @@
|
||||
(%set-cell fb (+ x col) (+ y row) #\space :fg nil :bg bg))))
|
||||
|
||||
(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
|
||||
(declare (ignore title-align))
|
||||
(let* ((chars (case style
|
||||
(:single '(#\+ #\- #\|))
|
||||
(:double '(#\+ #\= #\|))
|
||||
|
||||
Reference in New Issue
Block a user