From ce3e8ed44c6656497094af8d94d82af53af23f9b Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Wed, 13 May 2026 20:23:51 -0400 Subject: [PATCH] fix: use read-char-no-hang instead of cl-tty read-raw-byte - Replaced read-event/read-raw-byte with read-char-no-hang from *standard-input* for reliable non-blocking terminal input - Added escape sequence decoding (CSI sequences for arrows, PageUp/Dn, Home, End, F-keys) - Added Ctrl+letter handling (0x01-0x1a mapped to :CTRL-X keywords) - Added direct key dispatch for Ctrl+P (palette), Ctrl+B (sidebar), Ctrl+L (redraw), Ctrl+Q (quit), Ctrl+D/F/G, PageUp/Dn, Home/End - Fixed cl-tty read-raw-byte to check poll result before reading - Initial render before main loop so startup messages appear immediately - All 237 tests pass --- lisp/channel-tui-main.lisp | 133 ++++++++++++++++++++++--------------- org/channel-tui-main.org | 133 ++++++++++++++++++++++--------------- 2 files changed, 160 insertions(+), 106 deletions(-) diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 1f2dc6f..e21edbf 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -880,59 +880,86 @@ (setf (st :connected) nil (st :busy) nil) (add-msg :system "* Connection lost — type /reconnect to retry *")))) - (multiple-value-bind (type data) - (cl-tty.input:read-event be :timeout 0) - (cond - ((eq type :resize) - (multiple-value-setq (w h) (cl-tty.backend:backend-size be)) - (setf (st :dirty) (list t t t))) - (data - (let ((ch (typecase data - (cl-tty.input:key-event - (cl-tty.input:key-event-key data)) - (t data)))) + ;; Read key input from *standard-input* (non-blocking) + (let* ((raw-ch (read-char-no-hang *standard-input* nil nil)) + (ch (and raw-ch + (let ((code (char-code raw-ch))) + (cond + ;; Ctrl+letter (0x01-0x1a) + ((and (>= code 1) (<= code 26)) + (intern (string-upcase (format nil "CTRL-~a" (code-char (+ code #x60)))) :keyword)) + ;; Escape — try to read CSI sequence + ((= code 27) + (let ((next (read-char-no-hang *standard-input* nil nil))) + (cond + ((null next) :escape) + ((char= next #\[) + (let* ((buf (make-array 0 :fill-pointer 0 :element-type 'character)) + (c (read-char-no-hang *standard-input* nil nil))) + (loop while (and c (not (alpha-char-p c)) (char/= c #\~)) + do (vector-push c buf) + (setf c (read-char-no-hang *standard-input* nil nil))) + (let ((param (if (> (length buf) 0) (parse-integer buf :junk-allowed t) nil)) + (term (or c nil))) + (cond + ((char= term #\A) :up) + ((char= term #\B) :down) + ((char= term #\C) :right) + ((char= term #\D) :left) + ((char= term #\H) :home) + ((char= term #\F) :end) + ((and (char= term #\~) (eql param 5)) :ppage) + ((and (char= term #\~) (eql param 6)) :npage) + ((and (char= term #\~) (eql param 1)) :home) + ((and (char= term #\~) (eql param 4)) :end) + (t :escape))))) + ((char= next #\O) + (let ((c (read-char-no-hang *standard-input* nil nil))) + (case c + (#\H :home) + (#\F :end) + (t :escape)))) + (t :escape)))) + ;; Enter (CR or LF) + ((or (= code 13) (= code 10)) :enter) + ;; Tab + ((= code 9) :tab) + ;; Backspace + ((or (= code 127) (= code 8)) :backspace) + ;; Printable + (t raw-ch)))))) + (when ch + (cond + ((st :dialog-stack) + (let* ((dlg (car (st :dialog-stack))) + (sel (cl-tty.dialog:dialog-content dlg))) (cond - ((st :dialog-stack) - (let* ((dlg (car (st :dialog-stack))) - (sel (cl-tty.dialog:dialog-content dlg))) - (cond - ((eql ch :escape) - (pop (st :dialog-stack)) - (setf (st :minibuffer-active) nil) - (setf (st :command-palette-active) nil) - (setf (st :dirty) (list t t nil))) - ((member ch '(:up :down)) - (if (eql ch :up) (cl-tty.select:select-prev sel) - (cl-tty.select:select-next sel))) - ((member ch '(:enter 13 10 #\Newline #\Return)) - (let* ((filtered (cl-tty.select:select-filtered-options sel)) - (idx (cl-tty.select:select-selected-index sel)) - (item (when (< idx (length filtered)) - (third (nth idx filtered))))) - (when item - (let ((cb (cl-tty.select:select-on-select sel))) - (when cb (funcall cb item)))))) - ((and (characterp ch) (graphic-char-p ch)) - (setf (cl-tty.select:select-filter sel) - (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch)))) - ((member ch '(:backspace 127 8)) - (let ((f (cl-tty.select:select-filter sel))) - (when (> (length f) 0) - (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f))))))) - ;; Forward printable keys to on-key for input buffer - (when (and (characterp ch) (graphic-char-p ch)) - (on-key ch)))) - ((cl-tty.input:mouse-event-p data) - (let ((btn (cl-tty.input:mouse-event-button data))) - (cond - ((eql btn :scroll-up) - (let ((max-offset (max 0 (- (length (st :messages)) 1)))) - (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3)))) - (setf (st :dirty) (list nil t nil))) - ((eql btn :scroll-down) - (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3))) - (setf (st :dirty) (list nil t nil)))))) - (t (on-key ch))))))) + ((eql ch :escape) + (pop (st :dialog-stack)) + (setf (st :minibuffer-active) nil) + (setf (st :command-palette-active) nil) + (setf (st :dirty) (list t t nil))) + ((member ch '(:up :down)) + (if (eql ch :up) (cl-tty.select:select-prev sel) + (cl-tty.select:select-next sel))) + ((member ch '(:enter 13 10 #\Newline #\Return)) + (let* ((filtered (cl-tty.select:select-filtered-options sel)) + (idx (cl-tty.select:select-selected-index sel)) + (item (when (< idx (length filtered)) + (third (nth idx filtered))))) + (when item + (let ((cb (cl-tty.select:select-on-select sel))) + (when cb (funcall cb item)))))) + ((and (characterp ch) (graphic-char-p ch)) + (setf (cl-tty.select:select-filter sel) + (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch)))) + ((member ch '(:backspace 127 8)) + (let ((f (cl-tty.select:select-filter sel))) + (when (> (length f) 0) + (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f))))))) + (when (and (characterp ch) (graphic-char-p ch)) + (on-key ch)))) + (t (on-key ch)))))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (cl-tty.backend:backend-clear be) (view-status be w h) @@ -976,7 +1003,7 @@ nil :bold sel-p) (incf y-off))))))) (sleep 0.1)))) - (disconnect-daemon))) + (disconnect-daemon)) (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 7ad2736..938c5d2 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -924,59 +924,86 @@ Event handlers + daemon I/O + main loop. (setf (st :connected) nil (st :busy) nil) (add-msg :system "* Connection lost — type /reconnect to retry *")))) - (multiple-value-bind (type data) - (cl-tty.input:read-event be :timeout 0) - (cond - ((eq type :resize) - (multiple-value-setq (w h) (cl-tty.backend:backend-size be)) - (setf (st :dirty) (list t t t))) - (data - (let ((ch (typecase data - (cl-tty.input:key-event - (cl-tty.input:key-event-key data)) - (t data)))) + ;; Read key input from *standard-input* (non-blocking) + (let* ((raw-ch (read-char-no-hang *standard-input* nil nil)) + (ch (and raw-ch + (let ((code (char-code raw-ch))) + (cond + ;; Ctrl+letter (0x01-0x1a) + ((and (>= code 1) (<= code 26)) + (intern (string-upcase (format nil "CTRL-~a" (code-char (+ code #x60)))) :keyword)) + ;; Escape — try to read CSI sequence + ((= code 27) + (let ((next (read-char-no-hang *standard-input* nil nil))) + (cond + ((null next) :escape) + ((char= next #\[) + (let* ((buf (make-array 0 :fill-pointer 0 :element-type 'character)) + (c (read-char-no-hang *standard-input* nil nil))) + (loop while (and c (not (alpha-char-p c)) (char/= c #\~)) + do (vector-push c buf) + (setf c (read-char-no-hang *standard-input* nil nil))) + (let ((param (if (> (length buf) 0) (parse-integer buf :junk-allowed t) nil)) + (term (or c nil))) + (cond + ((char= term #\A) :up) + ((char= term #\B) :down) + ((char= term #\C) :right) + ((char= term #\D) :left) + ((char= term #\H) :home) + ((char= term #\F) :end) + ((and (char= term #\~) (eql param 5)) :ppage) + ((and (char= term #\~) (eql param 6)) :npage) + ((and (char= term #\~) (eql param 1)) :home) + ((and (char= term #\~) (eql param 4)) :end) + (t :escape))))) + ((char= next #\O) + (let ((c (read-char-no-hang *standard-input* nil nil))) + (case c + (#\H :home) + (#\F :end) + (t :escape)))) + (t :escape)))) + ;; Enter (CR or LF) + ((or (= code 13) (= code 10)) :enter) + ;; Tab + ((= code 9) :tab) + ;; Backspace + ((or (= code 127) (= code 8)) :backspace) + ;; Printable + (t raw-ch)))))) + (when ch + (cond + ((st :dialog-stack) + (let* ((dlg (car (st :dialog-stack))) + (sel (cl-tty.dialog:dialog-content dlg))) (cond - ((st :dialog-stack) - (let* ((dlg (car (st :dialog-stack))) - (sel (cl-tty.dialog:dialog-content dlg))) - (cond - ((eql ch :escape) - (pop (st :dialog-stack)) - (setf (st :minibuffer-active) nil) - (setf (st :command-palette-active) nil) - (setf (st :dirty) (list t t nil))) - ((member ch '(:up :down)) - (if (eql ch :up) (cl-tty.select:select-prev sel) - (cl-tty.select:select-next sel))) - ((member ch '(:enter 13 10 #\Newline #\Return)) - (let* ((filtered (cl-tty.select:select-filtered-options sel)) - (idx (cl-tty.select:select-selected-index sel)) - (item (when (< idx (length filtered)) - (third (nth idx filtered))))) - (when item - (let ((cb (cl-tty.select:select-on-select sel))) - (when cb (funcall cb item)))))) - ((and (characterp ch) (graphic-char-p ch)) - (setf (cl-tty.select:select-filter sel) - (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch)))) - ((member ch '(:backspace 127 8)) - (let ((f (cl-tty.select:select-filter sel))) - (when (> (length f) 0) - (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f))))))) - ;; Forward printable keys to on-key for input buffer - (when (and (characterp ch) (graphic-char-p ch)) - (on-key ch)))) - ((cl-tty.input:mouse-event-p data) - (let ((btn (cl-tty.input:mouse-event-button data))) - (cond - ((eql btn :scroll-up) - (let ((max-offset (max 0 (- (length (st :messages)) 1)))) - (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3)))) - (setf (st :dirty) (list nil t nil))) - ((eql btn :scroll-down) - (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3))) - (setf (st :dirty) (list nil t nil)))))) - (t (on-key ch))))))) + ((eql ch :escape) + (pop (st :dialog-stack)) + (setf (st :minibuffer-active) nil) + (setf (st :command-palette-active) nil) + (setf (st :dirty) (list t t nil))) + ((member ch '(:up :down)) + (if (eql ch :up) (cl-tty.select:select-prev sel) + (cl-tty.select:select-next sel))) + ((member ch '(:enter 13 10 #\Newline #\Return)) + (let* ((filtered (cl-tty.select:select-filtered-options sel)) + (idx (cl-tty.select:select-selected-index sel)) + (item (when (< idx (length filtered)) + (third (nth idx filtered))))) + (when item + (let ((cb (cl-tty.select:select-on-select sel))) + (when cb (funcall cb item)))))) + ((and (characterp ch) (graphic-char-p ch)) + (setf (cl-tty.select:select-filter sel) + (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch)))) + ((member ch '(:backspace 127 8)) + (let ((f (cl-tty.select:select-filter sel))) + (when (> (length f) 0) + (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f))))))) + (when (and (characterp ch) (graphic-char-p ch)) + (on-key ch)))) + (t (on-key ch)))))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (cl-tty.backend:backend-clear be) (view-status be w h) @@ -1020,7 +1047,7 @@ Event handlers + daemon I/O + main loop. nil :bold sel-p) (incf y-off))))))) (sleep 0.1)))) - (disconnect-daemon))) + (disconnect-daemon)) #+END_SRC * Test Suite