From 225b52a9d8acd362be58fa7d38670647141f5fd4 Mon Sep 17 00:00:00 2001 From: Hermes Date: Mon, 11 May 2026 22:50:31 +0000 Subject: [PATCH] review fixes: version bump, remove dead test file, fix extract-text bounds, fix markdown package, update roadmap --- cl-tty.asd | 2 +- demo.lisp | 2 +- docs/ROADMAP.org | 6 +- org/framebuffer.org | 4 +- src/components/markdown-package.lisp | 2 +- src/rendering/framebuffer.lisp | 4 +- tests/input-tests.lisp | 269 --------------------------- 7 files changed, 10 insertions(+), 279 deletions(-) delete mode 100644 tests/input-tests.lisp diff --git a/cl-tty.asd b/cl-tty.asd index 8ab49a8..b5c33a8 100644 --- a/cl-tty.asd +++ b/cl-tty.asd @@ -2,7 +2,7 @@ (asdf:defsystem :cl-tty :description "Reusable Common Lisp Terminal UI Framework" :author "Amr Gharbeia" - :version "0.13.0" + :version "0.14.0" :license "GPL-3.0" :depends-on (:fiveam :sb-posix) :components diff --git a/demo.lisp b/demo.lisp index 3aedd7d..de2b165 100644 --- a/demo.lisp +++ b/demo.lisp @@ -69,7 +69,7 @@ for pair = (nth i '(("Versions" "11") ("Components" "12") ("Tests" "280+") ("Lines" "~3060") ("Dependencies" "0") ("FFI" "0") - ("ncurses" "no") ("License" "TBD"))) + ("ncurses" "no") ("License" "GPL-3.0"))) do (cl-tty.backend:draw-text be 8 (+ 11 i) (first pair) :white :default) (cl-tty.backend:draw-text be 40 (+ 11 i) (second pair) :bright-green :default :bold t))) diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index 961b99d..c6f5b21 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -174,8 +174,8 @@ Checklist: | 7 | Dialog system + Toast | ~220 | v0.9.0 | DONE | | 8 | Mouse support | ~80 | v0.10.0 | DONE | | 9 | Plugin / slot system | ~50 | v0.11.0 | DONE | -| 10 | Terminal capability detection | ~100 | v0.12.0 | TODO | -| 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.0 | TODO | -| 12 | Mouse improvements (selection, links) | ~80 | v0.14.0 | TODO | +| 10 | Terminal capability detection | ~100 | v0.12.0 | DONE | +| 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.0 | DONE | +| 12 | Mouse improvements (selection, links) | ~80 | v0.14.0 | DONE | |-------+----------------------------------------+--------+---------|--------| | | Total | ~2800 | | | diff --git a/org/framebuffer.org b/org/framebuffer.org index b9fe675..e8a5baf 100644 --- a/org/framebuffer.org +++ b/org/framebuffer.org @@ -320,8 +320,8 @@ Returns the number of changed cells." (defun extract-text (fb x1 y1 x2 y2) "Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)." - (let ((x-min (min x1 x2)) (x-max (max x1 x2)) - (y-min (min y1 y2)) (y-max (max y1 y2)) + (let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2))) + (y-min (max 0 (min y1 y2))) (y-max (max 0 (max y1 y2))) (h (if (arrayp fb) (array-dimension fb 0) 0)) (w (if (arrayp fb) (array-dimension fb 1) 0))) (with-output-to-string (s) diff --git a/src/components/markdown-package.lisp b/src/components/markdown-package.lisp index 4d57153..ca97c8c 100644 --- a/src/components/markdown-package.lisp +++ b/src/components/markdown-package.lisp @@ -1,7 +1,7 @@ ;;; markdown-package.lisp — Package definition for cl-tty.markdown (defpackage :cl-tty.markdown - (:use :cl :fiveam) + (:use :cl) (:export ;; Data structures #:make-md-node diff --git a/src/rendering/framebuffer.lisp b/src/rendering/framebuffer.lisp index 8526a68..e091198 100644 --- a/src/rendering/framebuffer.lisp +++ b/src/rendering/framebuffer.lisp @@ -186,8 +186,8 @@ Returns the number of changed cells." (defun extract-text (fb x1 y1 x2 y2) "Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)." - (let ((x-min (min x1 x2)) (x-max (max x1 x2)) - (y-min (min y1 y2)) (y-max (max y1 y2)) + (let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2))) + (y-min (max 0 (min y1 y2))) (y-max (max 0 (max y1 y2))) (h (if (arrayp fb) (array-dimension fb 0) 0)) (w (if (arrayp fb) (array-dimension fb 1) 0))) (with-output-to-string (s) diff --git a/tests/input-tests.lisp b/tests/input-tests.lisp deleted file mode 100644 index 1f3971f..0000000 --- a/tests/input-tests.lisp +++ /dev/null @@ -1,269 +0,0 @@ -(defpackage :cl-tty-input-test - (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input) - (:export #:run-tests)) -(in-package :cl-tty-input-test) - -(def-suite input-suite :description "Text input and keybinding tests") -(in-suite input-suite) - -(defun run-tests () - (let ((result (run 'input-suite))) - (fiveam:explain! result) - (uiop:quit 0))) - -;; ── Key Event Tests ───────────────────────────────────────────── - -(test key-event-construction - "A key-event can be created and queried." - (let ((e (make-key-event :key :a :ctrl t :alt nil))) - (is (eql (key-event-key e) :a)) - (is-true (key-event-ctrl e)) - (is-false (key-event-alt e)))) - -(test key-event-defaults - "Fields default to NIL/nil." - (let ((e (make-key-event :key :space))) - (is (eql (key-event-key e) :space)) - (is-false (key-event-ctrl e)) - (is-false (key-event-alt e)) - (is-false (key-event-shift e)))) - -(test mouse-event-construction - "A mouse-event can be created and queried." - (let ((e (make-mouse-event :type :press :button :left :x 10 :y 5))) - (is (eql (mouse-event-type e) :press)) - (is (eql (mouse-event-button e) :left)) - (is (= (mouse-event-x e) 10)) - (is (= (mouse-event-y e) 5)))) - -;; ── TextInput Tests ───────────────────────────────────────────── - -(test text-input-empty - "A newly created text-input has empty value and cursor at 0." - (let ((in (make-text-input))) - (is (string= (text-input-value in) "")) - (is (= (text-input-cursor in) 0)))) - -(test text-input-insert-char - "Inserting a character appends and moves cursor." - (let ((in (make-text-input))) - (handle-text-input in (make-key-event :key :a :code (char-code #\a))) - (is (string= (text-input-value in) "a")) - (is (= (text-input-cursor in) 1)))) - -(test text-input-insert-multiple - "Inserting multiple characters works left to right." - (let ((in (make-text-input))) - (handle-text-input in (make-key-event :key :h :code (char-code #\h))) - (handle-text-input in (make-key-event :key :e :code (char-code #\e))) - (handle-text-input in (make-key-event :key :l :code (char-code #\l))) - (handle-text-input in (make-key-event :key :l :code (char-code #\l))) - (handle-text-input in (make-key-event :key :o :code (char-code #\o))) - (is (string= (text-input-value in) "hello")) - (is (= (text-input-cursor in) 5)))) - -(test text-input-backspace - "Backspace removes the character before the cursor." - (let ((in (make-text-input :value "ab" :cursor 2))) - (handle-text-input in (make-key-event :key :backspace)) - (is (string= (text-input-value in) "a")) - (is (= (text-input-cursor in) 1)))) - -(test text-input-backspace-at-start - "Backspace at position 0 does nothing." - (let ((in (make-text-input :value "ab" :cursor 0))) - (handle-text-input in (make-key-event :key :backspace)) - (is (string= (text-input-value in) "ab")) - (is (= (text-input-cursor in) 0)))) - -(test text-input-delete - "Delete removes the character at the cursor." - (let ((in (make-text-input :value "abc" :cursor 1))) - (handle-text-input in (make-key-event :key :delete)) - (is (string= (text-input-value in) "ac")) - (is (= (text-input-cursor in) 1)))) - -(test text-input-cursor-left-right - "Cursor moves left and right." - (let ((in (make-text-input :value "ab" :cursor 2))) - (handle-text-input in (make-key-event :key :left)) - (is (= (text-input-cursor in) 1)) - (handle-text-input in (make-key-event :key :right)) - (is (= (text-input-cursor in) 2)))) - -(test text-input-cursor-bounds - "Cursor cannot move past start or end." - (let ((in (make-text-input :value "ab" :cursor 0))) - (handle-text-input in (make-key-event :key :left)) - (is (= (text-input-cursor in) 0)) - (setf (text-input-cursor in) 2) - (handle-text-input in (make-key-event :key :right)) - (is (= (text-input-cursor in) 2)))) - -(test text-input-home-end - "Home moves to start, End moves to end." - (let ((in (make-text-input :value "hello" :cursor 3))) - (handle-text-input in (make-key-event :key :home)) - (is (= (text-input-cursor in) 0)) - (handle-text-input in (make-key-event :key :end)) - (is (= (text-input-cursor in) 5)))) - -(test text-input-max-length - "Max-length prevents inserting beyond the limit." - (let ((in (make-text-input :max-length 3))) - (handle-text-input in (make-key-event :key :a :code (char-code #\a))) - (handle-text-input in (make-key-event :key :b :code (char-code #\b))) - (handle-text-input in (make-key-event :key :c :code (char-code #\c))) - (handle-text-input in (make-key-event :key :d :code (char-code #\d))) - (is (string= (text-input-value in) "abc")))) - -(test text-input-placeholder - "Placeholder is stored but does not affect value." - (let ((in (make-text-input :placeholder "Type here..."))) - (is (string= (text-input-placeholder in) "Type here...")) - (is (string= (text-input-value in) "")))) - -(test text-input-on-submit - "On-submit callback fires on Enter." - (let ((result (list nil))) - (let ((in (make-text-input :value "hello" - :on-submit (lambda (v) (setf (car result) v))))) - (handle-text-input in (make-key-event :key :enter)) - (is (string= (car result) "hello"))))) - -(test text-input-ctrl-a-e - "Ctrl+A moves to home, Ctrl+E moves to end." - (let ((in (make-text-input :value "abc" :cursor 2))) - (handle-text-input in (make-key-event :key :a :ctrl t)) - (is (= (text-input-cursor in) 0)) - (handle-text-input in (make-key-event :key :e :ctrl t)) - (is (= (text-input-cursor in) 3)))) - -(test text-input-insert-in-middle - "Inserting in the middle of text shifts rest right." - (let ((in (make-text-input :value "ab" :cursor 1))) - (handle-text-input in (make-key-event :key :x :code (char-code #\x))) - (is (string= (text-input-value in) "axb")) - (is (= (text-input-cursor in) 2)))) - -(test text-input-dirty-on-insert - "Inserting marks the widget dirty." - (let ((in (make-text-input))) - (mark-clean in) - (handle-text-input in (make-key-event :key :a :code (char-code #\a))) - (is-true (dirty-p in)))) - -;; ── Textarea Tests ────────────────────────────────────────────── - -(test textarea-empty - "New textarea has empty value and cursor at (0,0)." - (let ((a (make-textarea))) - (is (string= (textarea-value a) "")) - (is (= (textarea-cursor-row a) 0)) - (is (= (textarea-cursor-col a) 0)))) - -(test textarea-newline - "Enter inserts a newline." - (let ((a (make-textarea))) - (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) - (handle-textarea-input a (make-key-event :key :enter)) - (handle-textarea-input a (make-key-event :key :b :code (char-code #\b))) - (is (string= (textarea-value a) "a -b")))) - -(test textarea-cursor-up-down - "Cursor moves between lines maintaining column position." - (let ((a (make-textarea :value "abc -de -fghi"))) - (setf (textarea-cursor-row a) 1) - (setf (textarea-cursor-col a) 1) - (handle-textarea-input a (make-key-event :key :up)) - (is (= (textarea-cursor-row a) 0)) - (is (= (textarea-cursor-col a) 1)) - (handle-textarea-input a (make-key-event :key :down)) - (is (= (textarea-cursor-row a) 1)) - (is (= (textarea-cursor-col a) 1)))) - -(test textarea-cursor-up-down-bounds - "Cursor cannot move past first or last line." - (let ((a (make-textarea :value "a -b"))) - (handle-textarea-input a (make-key-event :key :up)) - (is (= (textarea-cursor-row a) 0)) - (setf (textarea-cursor-row a) 1) - (handle-textarea-input a (make-key-event :key :down)) - (is (= (textarea-cursor-row a) 1)))) - -(test textarea-backspace-joins-lines - "Backspace at start of a line joins with previous." - (let ((a (make-textarea :value "hello -world"))) - (setf (textarea-cursor-row a) 1) - (setf (textarea-cursor-col a) 0) - (handle-textarea-input a (make-key-event :key :backspace)) - (is (string= (textarea-value a) "helloworld")))) - -(test textarea-undo - "Ctrl+Z undoes the last edit." - (let ((a (make-textarea))) - (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) - (handle-textarea-input a (make-key-event :key :z :ctrl t)) - (is (string= (textarea-value a) "")))) - -(test textarea-undo-redo - "Ctrl+Y redoes an undone edit." - (let ((a (make-textarea))) - (handle-textarea-input a (make-key-event :key :a :code (char-code #\a))) - (handle-textarea-input a (make-key-event :key :z :ctrl t)) - (handle-textarea-input a (make-key-event :key :y :ctrl t)) - (is (string= (textarea-value a) "a")))) - -;; ── Keybinding Tests ──────────────────────────────────────────── - -(test keymap-simple - "A keymap dispatches to its handler on matching event." - (let ((called nil)) - (setf (gethash :global *keymaps*) - (make-keymap :name :global - :bindings `((:ctrl+p . ,(lambda (e) - (declare (ignore e)) - (setf called t)))))) - (is-true (dispatch-key-event (make-key-event :key :p :ctrl t))) - (is-true called))) - -(test keymap-no-match - "Non-matching event returns nil." - (let ((called nil)) - (setf (gethash :global *keymaps*) - (make-keymap :name :global - :bindings `((:ctrl+p . ,(lambda (e) - (declare (ignore e)) - (setf called t)))))) - (is-false (dispatch-key-event (make-key-event :key :a))) - (is-false called))) - -(test keymap-fallback - "Event not in local falls through to global." - (let ((global-called nil)) - (setf (gethash :global *keymaps*) - (make-keymap :name :global - :bindings `((:ctrl+q . ,(lambda (e) - (declare (ignore e)) - (setf global-called t)))))) - (dispatch-key-event (make-key-event :key :q :ctrl t)) - (is-true global-called))) - -(test key-spec-simple - "Keyword key-spec matches key+ctrl." - (is-true (key-match-p :ctrl+p (make-key-event :key :p :ctrl t))) - (is-false (key-match-p :ctrl+p (make-key-event :key :a :ctrl t))) - (is-false (key-match-p :ctrl+p (make-key-event :key :p)))) - -(test defkeymap-macro - "defkeymap macro registers a keymap." - (let ((called nil)) - (eval `(defkeymap :global - (:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t))))) - (dispatch-key-event (make-key-event :key :q :ctrl t)) - (is-true called)))