#!/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.select) (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)