v0.8.0: revert to stable e04b12c (undo typecase guard, navigation refactor, cursor calc changes)
The typecase guard, explicit navigation keyword dispatch, and word-wrap
cursor calculation changes introduced two regressions:
1. Cursor shows letter before instead of on (off-by-one)
2. Right arrow sometimes moves backward
Reverting to e04b12c which had working arrow keys and single-line cursor.
The unconditional position-cursor fix will be re-applied separately.
This commit is contained in:
@@ -34,9 +34,7 @@ Event handlers + daemon I/O + main loop.
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun on-key (key &key ctrl alt shift code)
|
||||
(let ((ch key))
|
||||
(declare (ignore alt shift))
|
||||
(defun on-key (ch)
|
||||
(cond
|
||||
;; v0.7.1: Esc — interrupt streaming
|
||||
((and (or (eq ch :escape) (eql ch 27)) (st :streaming-text))
|
||||
@@ -563,16 +561,16 @@ Event handlers + daemon I/O + main loop.
|
||||
(when (and chr (graphic-char-p chr))
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))
|
||||
(when (and (char= chr #\/) (null cl-tty.dialog:*dialog-stack*)
|
||||
(when (and (char= chr #\/) (null (st :dialog-stack))
|
||||
(= (length (st :input-buffer)) 1))
|
||||
(unified-menu-show "/"))))))))
|
||||
(unified-menu-show "/")))))))
|
||||
|
||||
;; v0.9.0 — unified command minibuffer (replaces separate palette and slash menus)
|
||||
(defun unified-menu-show (&optional initial-filter)
|
||||
"Open the command minibuffer with ALL commands. If INITIAL-FILTER is
|
||||
supplied (e.g. \"/\"), pre-fill the select filter with it."
|
||||
(let* ((on-select (lambda (opt)
|
||||
(cl-tty.dialog:pop-dialog)
|
||||
(pop (st :dialog-stack))
|
||||
(let ((val (getf opt :value)))
|
||||
(cond ((stringp val)
|
||||
;; Slash command — fill input buffer
|
||||
@@ -588,7 +586,7 @@ supplied (e.g. \"/\"), pre-fill the select filter with it."
|
||||
(when initial-filter
|
||||
(setf (cl-tty.select:select-filter sel) initial-filter))
|
||||
(let ((dlg (make-instance 'cl-tty.dialog:dialog :title "Commands" :content sel)))
|
||||
(cl-tty.dialog:push-dialog dlg))))
|
||||
(push dlg (st :dialog-stack)))))
|
||||
|
||||
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
|
||||
(defun resolve-hitl-panel (decision)
|
||||
@@ -880,8 +878,6 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(defvar *tty-in* nil "Stream from cat subprocess stdout (unused — direct stdin reads)")
|
||||
|
||||
(defun tui-main ()
|
||||
(format t "~&;; Passepartout TUI starting...~%")
|
||||
(finish-output)
|
||||
(init-state)
|
||||
(load-history)
|
||||
(theme-load)
|
||||
@@ -923,10 +919,8 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(loop while (and (st :running) (not (st :connected)))
|
||||
do (connect-daemon)
|
||||
(unless (st :connected) (sleep 5))))
|
||||
:name "daemon-auto-connect"))
|
||||
;; Force initial render before entering input loop
|
||||
(redraw be w h)
|
||||
(loop while (st :running) do
|
||||
:name "daemon-auto-connect"))
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
@@ -938,31 +932,28 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
((eq (getf ev :type) :key)
|
||||
(let* ((payload (getf ev :payload))
|
||||
(ch (getf payload :ch)))
|
||||
(case ch
|
||||
(:CTRL-Q (setf (st :running) nil))
|
||||
(:CTRL-P (unified-menu-show))
|
||||
(:CTRL-B (setf (st :sidebar-mode)
|
||||
(case (st :sidebar-mode)
|
||||
(:auto :visible)
|
||||
(:visible :hidden)
|
||||
(:hidden :auto)))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(:CTRL-L (setf (st :dirty) (list t t t)))
|
||||
;; v0.8.0: dispatch known navigation keywords
|
||||
((:up :down :left :right :enter :backspace :tab :escape
|
||||
:home :end :ppage :npage)
|
||||
(if cl-tty.dialog:*dialog-stack*
|
||||
(let* ((dlg (car cl-tty.dialog:*dialog-stack*))
|
||||
(case ch
|
||||
(:CTRL-Q (setf (st :running) nil))
|
||||
(:CTRL-P (unified-menu-show))
|
||||
(:CTRL-B (setf (st :sidebar-mode)
|
||||
(case (st :sidebar-mode)
|
||||
(:auto :visible)
|
||||
(:visible :hidden)
|
||||
(:hidden :auto)))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(:CTRL-L (setf (st :dirty) (list t t t)))
|
||||
(t (if (st :dialog-stack)
|
||||
(let* ((dlg (car (st :dialog-stack)))
|
||||
(sel (cl-tty.dialog:dialog-content dlg)))
|
||||
(cond
|
||||
((eql ch :escape)
|
||||
(cl-tty.dialog:pop-dialog)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((eql ch :escape)
|
||||
(pop (st :dialog-stack))
|
||||
(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))
|
||||
((member ch '(:enter 13 10))
|
||||
(let* ((filtered (cl-tty.select:select-filtered-options sel))
|
||||
(idx (cl-tty.select:select-selected-index sel))
|
||||
(item (when (< idx (length filtered))
|
||||
@@ -970,29 +961,20 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(when item
|
||||
(let ((cb (cl-tty.select:select-on-select sel)))
|
||||
(when cb (funcall cb item))))))
|
||||
((member ch '(:backspace))
|
||||
((let ((chr (if (characterp ch) ch
|
||||
(and (integerp ch) (<= 32 ch 126)
|
||||
(code-char ch)))))
|
||||
(and chr (graphic-char-p chr))
|
||||
(setf (cl-tty.select:select-filter sel)
|
||||
(concatenate 'string
|
||||
(or (cl-tty.select:select-filter sel) "")
|
||||
(string chr)))))
|
||||
((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))))))
|
||||
(t nil)))
|
||||
(on-key ch)))
|
||||
;; v0.8.0: typecase converts integers to characters
|
||||
;; so ctrl-byte keywords (:CTRL-A) are rejected
|
||||
(t (let ((chr (typecase ch
|
||||
(character ch)
|
||||
((integer 32 126) (code-char ch))
|
||||
(t nil))))
|
||||
(when chr
|
||||
(if cl-tty.dialog:*dialog-stack*
|
||||
(let* ((dlg (car cl-tty.dialog:*dialog-stack*))
|
||||
(sel (cl-tty.dialog:dialog-content dlg)))
|
||||
(when (graphic-char-p chr)
|
||||
(setf (cl-tty.select:select-filter sel)
|
||||
(concatenate 'string
|
||||
(or (cl-tty.select:select-filter sel) "")
|
||||
(string chr)))))
|
||||
(on-key chr :code (when (integerp ch) ch)))))))))))
|
||||
(subseq f 0 (1- f))))))))
|
||||
(on-key ch))))))))
|
||||
;; Keyboard reader via read-raw-byte (proven CSI detection)
|
||||
(handler-case
|
||||
(let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))
|
||||
@@ -1036,9 +1018,9 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
;; Guard w and h before render (resize or other code may have set them to nil)
|
||||
(setq w (or (and (numberp w) (> w 0) w) 80)
|
||||
h (or (and (numberp h) (> h 0) h) 24))
|
||||
(unless cl-tty.dialog:*dialog-stack*
|
||||
(redraw be w h))
|
||||
(let ((ds cl-tty.dialog:*dialog-stack*))
|
||||
(unless (st :dialog-stack)
|
||||
(redraw be w h))
|
||||
(let ((ds (st :dialog-stack)))
|
||||
(when ds
|
||||
(cl-tty.backend:begin-sync be)
|
||||
(let* ((chat-w (- w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0)))
|
||||
@@ -1093,9 +1075,11 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(format nil "> ~a" (or filter ""))
|
||||
(theme-color :input-prompt) bg-p))
|
||||
(cl-tty.backend:end-sync be))
|
||||
(sleep 0.1))
|
||||
(position-cursor be w h))
|
||||
(progn (disconnect-daemon)))))
|
||||
(sleep 0.1)
|
||||
;; Show terminal cursor at input position every frame
|
||||
(unless (st :dialog-stack)
|
||||
(passepartout.channel-tui:position-cursor be w h))))
|
||||
(progn (disconnect-daemon)))))
|
||||
#+END_SRC
|
||||
|
||||
* Test Suite
|
||||
@@ -1593,7 +1577,7 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(fiveam:test test-minibuffer-state
|
||||
"Contract v0.8.0: init-state has :dialog-stack and :minibuffer-active fields."
|
||||
(init-state)
|
||||
(fiveam:is (null cl-tty.dialog:*dialog-stack*))
|
||||
(fiveam:is (null (st :dialog-stack)))
|
||||
(fiveam:is (null (st :minibuffer-active))))
|
||||
|
||||
(fiveam:test test-command-palette-state
|
||||
|
||||
Reference in New Issue
Block a user