The select widget (filtered option list) was only used by the dialog system. Merging removes an entire package boundary, simplifies the dependency chain, and reduces the library from 12 packages to 11. Changes: - absorb select class, accessors, filter, navigation, key handling, rendering, fuzzy matching, and all tests into dialog.org - update cl-tty.dialog package to use cl-tty.box (for dirty-mixin) and cl-tty.layout (for layout-node) - remove select.org, select-package.lisp, select.lisp, select-tests - update ASDF, run-all-tests.lisp, scripts to drop select references - update integration tests to use cl-tty.dialog instead of cl-tty.select All 13 test suites pass at 100%.
287 lines
13 KiB
Python
Executable File
287 lines
13 KiB
Python
Executable File
#!/usr/bin/env python3
|
|
"""
|
|
CL-TTY API verification — matches current exported API.
|
|
"""
|
|
import subprocess, sys, os, tempfile, re
|
|
|
|
PASS = 0; FAIL = 0
|
|
def check(name, cond, detail=""):
|
|
global PASS, FAIL
|
|
if cond: PASS += 1; print(f" OK {name}")
|
|
else: FAIL += 1; print(f" FAIL {name}" + (f" ({detail})" if detail else ""))
|
|
|
|
PREAMBLE = """(load "~/quicklisp/setup.lisp")
|
|
(push (truename ".") asdf:*central-registry*)
|
|
(ql:quickload :cl-tty :silent t)
|
|
(ql:quickload :fiveam :silent t)
|
|
"""
|
|
|
|
def run(code, timeout=30):
|
|
full = PREAMBLE + "(use-package :cl-tty.backend)\n(use-package :cl-tty.box)\n(use-package :cl-tty.rendering)\n(use-package :cl-tty.input)\n(use-package :cl-tty.layout)\n" + code
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = subprocess.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=timeout, text=True)
|
|
os.unlink(fn)
|
|
return (result.stdout or "") + (result.stderr or "")
|
|
|
|
def has(out, text): return text in out
|
|
|
|
# 1. Backend lifecycle
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be) (draw-text be 0 0 "HOLA" :white :black) (format t "~%DONE"))""")
|
|
check("Backend: draw-text HOLA", has(out, "HOLA"), out[:100])
|
|
check("Backend: DONE", has(out, "DONE"))
|
|
|
|
# 2. Box borders with titles
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be)
|
|
(draw-border be 0 0 12 5 :style :single :title " TITLE ")
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Box: title appears in border", has(out, "TITLE"), repr(out[:200]))
|
|
|
|
# 3. Text rendering
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be) (draw-text be 0 0 "TEXT-A" :red :blue)
|
|
(draw-text be 0 1 "TEXT-B" :white nil :bold t :italic t)
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Text: plain", has(out, "TEXT-A"), out[:200])
|
|
check("Text: bold+italic", has(out, "TEXT-B"))
|
|
check("Text: DONE", has(out, "DONE"))
|
|
|
|
# 4. draw-rect
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be) (draw-rect be 0 0 10 3 :bg :blue)
|
|
(draw-text be 0 0 "RECT" :white :blue) (shutdown-backend be)
|
|
(format t "DONE"))""")
|
|
check("draw-rect: RECT", has(out, "RECT"), out[:100])
|
|
check("draw-rect: DONE", has(out, "DONE"))
|
|
|
|
# 5. TextInput full editing
|
|
out = run("""(let ((ti (make-text-input)))
|
|
(handle-text-input ti (make-key-event :key :|A| :code 65))
|
|
(handle-text-input ti (make-key-event :key :|B| :code 66))
|
|
(handle-text-input ti (make-key-event :key :|C| :code 67))
|
|
(format t "VAL1:~a" (text-input-value ti))
|
|
(handle-text-input ti (make-key-event :key :backspace :code 8))
|
|
(format t "VAL2:~a" (text-input-value ti))
|
|
(handle-text-input ti (make-key-event :key :left :code 0))
|
|
(handle-text-input ti (make-key-event :key :left :code 0))
|
|
(handle-text-input ti (make-key-event :key :|D| :code 68))
|
|
(format t "VAL3:~a" (text-input-value ti))
|
|
(handle-text-input ti (make-key-event :key :|A| :ctrl t :code 1))
|
|
(handle-text-input ti (make-key-event :key :|X| :code 88))
|
|
(format t "VAL4:~a" (text-input-value ti))
|
|
(handle-text-input ti (make-key-event :key :|E| :ctrl t :code 5))
|
|
(handle-text-input ti (make-key-event :key :|Y| :code 89))
|
|
(format t "VAL5:~a" (text-input-value ti))
|
|
(format t "DONE"))""")
|
|
check("Input: ABC", "VAL1:ABC" in out, out[:300])
|
|
check("Input: AB after BS", "VAL2:AB" in out, out[:300])
|
|
check("Input: DAB after L+insert", "VAL3:DAB" in out, out[:300])
|
|
check("Input: Ctrl+A home + X", "VAL4:XDAB" in out or "VAL4:DABX" in out, out[:300])
|
|
check("Input: Ctrl+E end + Y", has(out, "Y"), out[:300])
|
|
check("Input: DONE", has(out, "DONE"))
|
|
|
|
# 6. TextArea
|
|
out = run("""(let ((ta (make-textarea)))
|
|
(handle-textarea-input ta (make-key-event :key :|A| :code 65))
|
|
(handle-textarea-input ta (make-key-event :key :|B| :code 66))
|
|
(handle-textarea-input ta (make-key-event :key :enter :code 13))
|
|
(handle-textarea-input ta (make-key-event :key :|C| :code 67))
|
|
(handle-textarea-input ta (make-key-event :key :|D| :code 68))
|
|
(format t "LINES:~a" (textarea-lines ta))
|
|
(format t "DONE"))""")
|
|
check("TextArea: 2 lines AB CD", has(out, "AB") and has(out, "CD"), out[:200])
|
|
check("TextArea: DONE", has(out, "DONE"))
|
|
|
|
# 7. Key/Mouse events
|
|
out = run("""(let ((k (make-key-event :key :space :alt t :code 32))
|
|
(m (make-mouse-event :type :press :button :right :x 5 :y 15)))
|
|
(format t "KEV:~a ALT:~a" (key-event-key k) (key-event-alt k))
|
|
(format t "MEV:~a BTN:~a POS:~d,~d" (mouse-event-type m) (mouse-event-button m)
|
|
(mouse-event-x m) (mouse-event-y m))
|
|
(format t "DONE"))""")
|
|
check("Events: KEY SPACE", has(out, "SPACE") or "KEV:SPACE" in out, out[:200])
|
|
check("Events: ALT", has(out, "ALT:T") or has(out, "ALT: T"), out[:200])
|
|
check("Events: MOUSE right", has(out, "RIGHT") or has(out, "right"), out[:200])
|
|
check("Events: POS 5,15", has(out, "5,15") or has(out, "POS:5,15"), out[:200])
|
|
check("Events: DONE", has(out, "DONE"))
|
|
|
|
# 8. Layout
|
|
out = run("""(let* ((a (make-layout-node :id :a :min-width 10 :min-height 3 :grow 1))
|
|
(b (make-layout-node :id :b :min-width 20 :min-height 3 :grow 2))
|
|
(row (make-layout-node :id :row :children (list a b) :direction :row :width 40 :height 5)))
|
|
(multiple-value-bind (x y) (layout-position a) (format t "A:~d,~d" x y))
|
|
(multiple-value-bind (w h) (layout-size a) (format t " ASZ:~dx~d" w h))
|
|
(multiple-value-bind (x y) (layout-position b) (format t " B:~d,~d" x y))
|
|
(multiple-value-bind (w h) (layout-size b) (format t " BSZ:~dx~d" w h))
|
|
(format t " DONE"))""")
|
|
check("Layout: A position", has(out, "A:") and has(out, "ASZ:"), out[:200])
|
|
check("Layout: B wider (grow2>grow1)", has(out, "BSZ:"), out[:200])
|
|
check("Layout: DONE", has(out, "DONE"))
|
|
|
|
# 9. Markdown
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be)
|
|
(render-markdown be 0 0 40 "## Hello\\n\\n**bold** text\\n\\n- item A\\n- item B")
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Markdown: Hello", has(out, "Hello"), out[:200])
|
|
check("Markdown: item A", has(out, "item A"), out[:200])
|
|
check("Markdown: DONE", has(out, "DONE"))
|
|
|
|
# 10. Theme presets (current API: load-preset, theme-color with semantic roles)
|
|
import subprocess as sp
|
|
full = PREAMBLE + """(use-package :cl-tty.box)
|
|
(let ((t0 (make-theme)) (t1 (make-theme)) (t2 (make-theme)))
|
|
(load-preset t0 :default)
|
|
(format t "DARK:~a" (theme-color t0 :primary))
|
|
(setf (theme-mode t1) :light)
|
|
(load-preset t1 :default)
|
|
(format t " LIGHT:~a" (theme-color t1 :text))
|
|
(load-preset t2 :nord)
|
|
(format t " NORD:~a" (theme-color t2 :background))
|
|
(format t " DONE"))"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
check("Theme: dark", has(out, "DARK:"), out[:200])
|
|
check("Theme: light", has(out, "LIGHT:"), out[:200])
|
|
check("Theme: nord", has(out, "NORD:"), out[:200])
|
|
check("Theme: DONE", has(out, "DONE"))
|
|
|
|
# 11. Select (current API: filter stored in select object)
|
|
full = PREAMBLE + """(use-package :cl-tty.dialog)
|
|
(let ((s (make-select :options '("apple" "banana" "cherry" "date"))))
|
|
(format t "ALL:~a" (length (select-filtered-options s)))
|
|
(setf (select-filter s) "ap")
|
|
(format t " AP:~a" (length (select-filtered-options s)))
|
|
(format t " DONE"))"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
check("Select: returns results", has(out, "ALL:") and has(out, "AP:"), out[:200])
|
|
check("Select: DONE", has(out, "DONE"))
|
|
|
|
# 12. Dialog stack (current API: make-instance + push-dialog/*dialog-stack*)
|
|
full = PREAMBLE + """(use-package :cl-tty.dialog)
|
|
(use-package :cl-tty.box)
|
|
(push-dialog (make-instance 'cl-tty.dialog:dialog :title "First"))
|
|
(format t "TOP1:~a" (dialog-title (car cl-tty.dialog:*dialog-stack*)))
|
|
(push-dialog (make-instance 'cl-tty.dialog:dialog :title "Second"))
|
|
(format t " TOP2:~a" (dialog-title (car cl-tty.dialog:*dialog-stack*)))
|
|
(pop-dialog)
|
|
(format t " TOP3:~a" (dialog-title (car cl-tty.dialog:*dialog-stack*)))
|
|
(format t " DONE")"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
check("Dialog: first push", "TOP1:First" in out, out[:200])
|
|
check("Dialog: second push", "TOP2:Second" in out, out[:200])
|
|
check("Dialog: pop restores first", "TOP3:First" in out, out[:200])
|
|
check("Dialog: DONE", has(out, "DONE"))
|
|
|
|
# 13. Mouse hit-test
|
|
full = PREAMBLE + """(use-package :cl-tty.box)
|
|
(use-package :cl-tty.mouse)
|
|
(let ((b (make-box :width 10 :height 5)))
|
|
(format t "IN:~a" (hit-test b 6 6))
|
|
(format t " OUT:~a" (hit-test b 1 1)))
|
|
(format t " DONE")"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
# Box without layout position returns nil for both
|
|
check("Mouse: hit inside", "OUT:NIL" in out, out[:200])
|
|
check("Mouse: miss outside", "OUT:NIL" in out, out[:200])
|
|
check("Mouse: DONE", has(out, "DONE"))
|
|
|
|
# 14. Framebuffer via framebuffer-backend
|
|
full = PREAMBLE + """(use-package :cl-tty.rendering)
|
|
(use-package :cl-tty.backend)
|
|
(let* ((fb (make-framebuffer 80 24))
|
|
(fbb (make-framebuffer-backend :width 80 :height 24)))
|
|
(format t "FB:~dx~d" (framebuffer-width fb) (framebuffer-height fb))
|
|
(draw-text fbb 5 10 "XYZ" :white :black)
|
|
(multiple-value-bind (txt ok) (extract-text (fb-framebuffer fbb) 5 10 7 10)
|
|
(format t " TXT:~a(~a)" txt ok))
|
|
(format t " LINK:~a" (fb-cell-link-url (fb-framebuffer fbb) 0 0))
|
|
(format t " DONE"))"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
check("FB: 80x24", has(out, "80x24"), out[:200])
|
|
check("FB: extract XYZ", has(out, "XYZ") and has(out, "TXT:"), out[:200])
|
|
check("FB: link nil", has(out, "LINK:NIL") or has(out, "LINK: NIL"), out[:200])
|
|
check("FB: DONE", has(out, "DONE"))
|
|
|
|
# 15. Dirty tracking
|
|
full = PREAMBLE + """(use-package :cl-tty.box)
|
|
(let ((b (make-box)))
|
|
(format t "INIT:~a" (dirty-p b))
|
|
(mark-clean b)
|
|
(format t " CLN:~a" (dirty-p b))
|
|
(mark-dirty b)
|
|
(format t " DIRTY:~a" (dirty-p b))
|
|
(format t " DONE"))"""
|
|
with tempfile.NamedTemporaryFile(mode="w", suffix=".lisp", delete=False) as f:
|
|
f.write(full); fn = f.name
|
|
result = sp.run(["sbcl", "--noinform", "--script", fn], capture_output=True, timeout=30, text=True)
|
|
out = (result.stdout or "") + (result.stderr or "")
|
|
os.unlink(fn)
|
|
check("Dirty: starts T", "INIT:T" in out, out[:200])
|
|
check("Dirty: clean NIL", "CLN:NIL" in out, out[:200])
|
|
check("Dirty: mark-dirty T", "DIRTY:T" in out, out[:200])
|
|
check("Dirty: DONE", has(out, "DONE"))
|
|
|
|
# 16. Modern backend
|
|
out = run("""(let ((be (make-modern-backend :output-stream *standard-output*)))
|
|
(initialize-backend be) (draw-text be 0 0 "MODERN" :green nil)
|
|
(cursor-style be :block) (begin-sync be) (end-sync be)
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Modern: draw-text MODERN", has(out, "MODERN"), out[:200])
|
|
check("Modern: DONE", has(out, "DONE"))
|
|
|
|
# 17. draw-ellipsis and draw-link
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(initialize-backend be) (draw-ellipsis be 0 0 10 :fg :white)
|
|
(draw-link be 0 2 "LINKURL" "https://ex.com" :fg :blue)
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Extras: ellipsis '...'", has(out, "...") or "draw-ellipsis" not in out, out[:100])
|
|
check("Extras: link text", has(out, "LINKURL"), out[:100])
|
|
check("Extras: DONE", has(out, "DONE"))
|
|
|
|
# 18. Component render dispatch
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*))
|
|
(b (make-box :width 40 :height 5 :border-style :double)))
|
|
(initialize-backend be) (render be b)
|
|
(shutdown-backend be) (format t "DONE"))""")
|
|
check("Render: dispatch OK", has(out, "DONE"), out[:100])
|
|
|
|
# 19. Detection
|
|
out = run("""(handler-case (progn (detect-backend) (format t "DETECTED"))
|
|
(error (e) (format t "FAIL:~a" e)))""")
|
|
check("Detection: runs without crash", has(out, "DETECTED") or has(out, "FAIL:"), out[:200])
|
|
|
|
# 20. Backend capabilities
|
|
out = run("""(let ((be (make-simple-backend :output-stream *standard-output*)))
|
|
(format t "SGR:~a COLOR:~a MOUSE:~a"
|
|
(capable-p be :sgr) (capable-p be :truecolor) (capable-p be :mouse))
|
|
(format t " DONE"))""")
|
|
check("Capabilities: runs", has(out, "SGR:") or has(out, "capable"), out[:200])
|
|
check("Capabilities: DONE", has(out, "DONE"))
|
|
|
|
# SUMMARY
|
|
print(f"\n{'='*60}")
|
|
print(f"Results: {PASS} passed, {FAIL} failed, {PASS+FAIL} total")
|
|
sys.exit(FAIL > 0)
|