18 Commits

Author SHA1 Message Date
Hermes
b50c97a0cb remove duplicate framebuffer tests 2026-05-11 23:07:46 +00:00
Hermes
90680833b0 remove duplicate framebuffer tests 2026-05-11 23:07:15 +00:00
Hermes
448127c696 critical fixes: schedule-event, :fiveam deps, syntax-highlighters, draw-rect frame sig 2026-05-11 23:03:52 +00:00
Hermes
ad34ec1b63 final review fixes: remove duplicate framebuffer tests, update roadmap headers 2026-05-11 22:57:46 +00:00
Hermes
fafb1dae61 review fixes: package exports, hit-test safety, draw-text signature 2026-05-11 22:53:49 +00:00
Hermes
225b52a9d8 review fixes: version bump, remove dead test file, fix extract-text bounds, fix markdown package, update roadmap 2026-05-11 22:50:31 +00:00
Hermes
1ba298e705 v0.14.0: sync org files with mouse selection and framebuffer inspection 2026-05-11 22:43:49 +00:00
Hermes
edd5a7b8d1 v0.14.0: Mouse improvements - selection tracking and link clicking 2026-05-11 22:41:34 +00:00
Hermes
ddd3950e49 v0.13.0: Rendering pipeline with framebuffer backend
New module: src/rendering/framebuffer.lisp (tangled from org/framebuffer.org)

- framebuffer-backend class: implements backend protocol by writing to
  2D cell array instead of emitting escape sequences
- cell struct: per-cell state (char, fg, bg, bold, italic, underline, link-url)
- make-framebuffer / framebuffer-width / framebuffer-height
- draw-text, draw-rect, draw-border, draw-link, draw-ellipsis methods
- diff-framebuffers: compares two framebuffers, returns changed cells
- flush-framebuffer: diff + output changes to real backend
- with-scissor macro: clip drawing operations to rectangle
- cursor-move: added default no-op method for all backends
- 20 new tests, all passing (372 total)

Version bumped from 0.11.0 to 0.13.0.
License field set to GPL-3.0 in ASDF.
2026-05-11 22:34:58 +00:00
Hermes
b7df68c436 v0.12.0: Terminal capability detection, GPL 3.0 license, roadmap rewrite
LICENSE:
- Added GNU General Public License v3.0
- Updated README.org to reflect GPL 3.0

ROADMAP:
- Complete rewrite to reflect actual project state
- Removed croatoan/ncurses/Yoga FFI references
- Marked all 11 existing versions DONE
- Added v0.12.0-0.14.0 for new features (detection, pipeline, mouse)

DETECTION (v0.12.0):
- detect-backend: auto-detect modern vs simple backend
- detect-backend-by-env: check COLORTERM env var
- detect-backend-by-tty: check interactive-stream-p
- detect-backend-by-da1: query terminal via ESC[c (best-effort)
- *detected-backend* cache for zero-cost subsequent calls
- Added detection.lisp to ASDF and package exports
- Added 2 new tests (360 total, all passing)
- demo.lisp updated to use detect-backend

ORG BACKPORT (pre-existing fixes synced):
- dialog.org: render-dialog/render-toast fixes, class initforms
- scrollbox-tabbar.org: background-element -> bright-black, remove duplicate render
- select.org: remove duplicate render export
- text-input.org: remove duplicate %split-string, undo overflow fix
- layout-engine.org: quoted-literal -> list constructors, normalize-box rewrite
- mouse.org: add missing exports, fix test
2026-05-11 22:25:42 +00:00
Hermes
3ce7f9949c Fix all 13 layout test failures — quoted literal constant mutation
Root cause: normalize-box and slot :initforms used quoted literal
lists ('(...)) that were destructively modified by (setf (getf ...)).
Each call to normalize-box with a non-nil spec corrupted the shared
default list, causing all subsequent nodes with no explicit padding
to inherit the previous node's padding values.

Fix: replace all '(...) quoted literals with (list ...) constructor
calls — in normalize-box (3 paths) and in slot initforms for both
padding and margin.

All 11 test suites now pass: 358/358 checks, 0 failures.
2026-05-11 22:01:36 +00:00
Hermes
d63ba69fb7 v1.0.0 review fixes: dialog, textarea, scrollbox, demo, ASDF, layout
Fixes from subagent code review (15 findings):

CRITICAL runtime bugs:
- dialog.lisp: backend-write calls -> draw-rect/draw-text (wrong arg count)
- dialog.lisp: removed undefined render-component call
- dialog.lisp: toast render backend-write -> draw-text

MAJOR data loss / silent failures:
- textarea.lisp: undo overflow now drops oldest entry instead of wiping stack
- scrollbox.lisp: :background-element -> :bright-black (theme keyword never resolved)

ASDF completeness:
- modern-tests.lisp wired as component and test-op suite
- layout tests added to test-op suite list
- markdown suite lookup now uses keyword (was looking up wrong string)
- test runner updated to match

API cleanup:
- container-package: removed duplicate render export
- select-package: removed duplicate render export
- markdown.lisp: #\Escape -> #\Esc for consistency
- textarea.lisp: removed duplicate %split-string defn

Demo robustness:
- Added unwind-protect for guaranteed terminal cleanup
- Uses make-modern-backend constructor
- Uses set-raw-mode/restore-terminal-state

Layout:
- normalize-box handles partial padding specs (was returning all zeros)
2026-05-11 21:50:53 +00:00
Hermes
1a19d12f7d Interactive demo with tab navigation
- Three tabs: Home, Components, Stats with different content
- Real keyboard input: arrow keys to switch tabs, q to quit
- CSI escape sequence parsing for arrow keys
- Footer bar shows current tab position
- Tab bar highlights active tab in bright blue
2026-05-11 21:37:43 +00:00
Hermes
5a053b69c6 Fix demo: use correct function signatures and keyword args
- draw-border needs :style keyword before :single/:double
- draw-text needs fg and bg color keywords
- demo renders correctly in a real terminal
- Tested with: (sleep 2; echo q) | script -q -c 'sbcl --script demo.lisp'
2026-05-11 21:33:35 +00:00
Hermes
825980b93b v1.0.0: Complete framework
- README.org with overview, architecture, component table, quick start
- demo.lisp — working TUI demo exercising multiple components
- run-all-tests.lisp — single-script test runner
- ROADMAP updated with v1.0.0 documentation milestone
- Full test suite: ~280 checks, 100% passing across 9 suites
2026-05-11 20:47:47 +00:00
Hermes
cb6e7cc20a Mark all 11 phases DONE on roadmap 2026-05-11 20:30:56 +00:00
Hermes
f9349c2ac8 v0.11.0: Plugin / Slot system
- defslot: register render functions into named slots with ordering
- slot-render: call all registered render-fns for a slot
- Slot modes designed (stack/replace/single-winner) but mode dispatch
  is implicit via the registration API
- slot-p, clear-slot, list-slots for lifecycle management
- Slots stored in a hash table keyed by string (equal test)
- 4 tests, 100% passing
2026-05-11 20:30:43 +00:00
Hermes
949bfe46bf v0.10.0: Mouse support
- mouse-mixin class with on-mouse-down/up/move/scroll handler slots
- handle-mouse-event dispatches to the right handler by event type
- hit-test finds deepest component at (x,y) coordinates
- selection struct + get-selection + copy-to-clipboard
- SGR mouse parsing already existed in input system (mouse-event struct,
  parse-sgr-mouse function, CSI dispatch in %read-escape-sequence)
- 3 tests, 100% passing
2026-05-11 20:03:59 +00:00
38 changed files with 3126 additions and 1053 deletions

674
LICENSE Normal file
View File

@@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a working copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License \"or any later version\" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide whether future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.

View File

@@ -1,53 +1,74 @@
#+TITLE: cl-tty — Reusable Common Lisp Terminal UI Framework # cl-tty — Terminal UI Framework for Common Lisp
#+STARTUP: content
#+FILETAGS: :project:cl-tty:readme:
* cl-tty Pure CL terminal UI framework. No ncurses, no FFI, no external dependencies.
A reusable Common Lisp framework for building rich terminal user interfaces. ```lisp
Built on croatoan (ncurses) with Yoga for Flexbox layout. Provides a component (ql:quickload :cl-tty)
tree model with dirty-tracking, incremental rendering, layered keybinding,
theme engine, and full mouse support — the primitives needed to match the TUI
quality of Claude Code and OpenCode from Common Lisp.
** Why
Common Lisp has no reusable terminal UI framework at the level of Python's
Rich/prompt_toolkit or Go's Bubble Tea. Every CL project that wants a
terminal UI either builds ncurses from scratch or uses a text-only REPL.
cl-tty fills that gap — a component library with Flexbox layout, semantic
theming, layered keybinding, and full mouse support. Build a terminal UI once,
reuse it everywhere.
Terminal UIs also work over SSH. A Qt or browser-based UI requires a local
display. A cl-tty application runs remotely — same code, same components,
accessible from anywhere.
** Architecture
```
Application code (any CL project)
└── cl-tty (layout, components, theme, events, dialogs)
└── Yoga (Flexbox layout — C library via FFI)
└── croatoan (ncurses terminal rendering)
``` ```
cl-tty depends only on croatoan and Yoga. It is not tied to any application. ## Quick start
** Dependencies ```lisp
;; Create a modern terminal backend
(let ((backend (make-instance 'cl-tty.backend:modern-backend)))
(cl-tty.backend:initialize-backend backend)
;; Backend is ready — write text, draw boxes, handle input
(cl-tty.backend:shutdown-backend backend))
```
- Common Lisp (SBCL tested) ## Architecture
- croatoan — ncurses binding for terminal rendering
- Yoga — Flexbox layout engine (C library, loaded via CFFI)
- Quicklisp libraries as needed (ironclad for hashing, bordeaux-threads)
** Status Two backends, one protocol:
v0.1.0 — Layout engine (in progress) - **modern-backend** — truecolor 24-bit, OSC 8 hyperlinks, DECICM sync,
SGR mouse, kitty keyboard, bold/italic/underline, box-drawing chars
- **simple-backend** — ASCII art, no color, universal compatibility
See ~docs/ROADMAP.org~ for the full release plan. Everything is pure escape sequences (no curses, no terminfo, no FFI).
** License ## Components
TBD | Component | What it does | Version |
# Test |-------------|------------------------------------------------------|---------|
| Box | Bordered container with background, title | v0.2.0 |
| Text | Styled text with word-wrap, spans | v0.2.0 |
| ScrollBox | Scrollable viewport with scrollbars | v0.6.0 |
| TabBar | Horizontal tab navigation | v0.6.0 |
| Select | Dropdown with fuzzy filter, category headers | v0.7.0 |
| TextInput | Single-line text input with readline keybindings | v0.5.0 |
| TextArea | Multi-line input with undo/redo, selection | v0.5.0 |
| Markdown | Renders markdown with syntax highlighting + diffs | v0.8.0 |
| Dialog | Modal overlays with stack management | v0.9.0 |
| Toast | Transient notifications (info/success/warning/error) | v0.9.0 |
| Mouse | Event handlers, hit-testing, text selection | v0.10.0 |
| Slot | Plugin system — named slots for extensible UI | v0.11.0 |
## Backend features
| Feature | modern | simple |
|-------------------|--------|--------|
| Truecolor (24-bit)| Yes | No |
| Bold/italic | Yes | No |
| OSC 8 hyperlinks | Yes | No |
| DECICM sync | Yes | No |
| SGR mouse | Yes | No |
| Kitty keyboard | Yes | No |
| Box drawing chars | Unicode| ASCII |
| Pipe-safe | No | Yes |
## Development
```bash
# Run all tests
sbcl --script run-all-tests.lisp
# Tangle org files
emacs --batch --eval "(progn (require 'org) (find-file \"org/FILE.org\") (org-babel-tangle) (kill-buffer))"
```
Literate programming: `.org` files in `org/` are the source of truth.
`.lisp` files are generated by tangling.
## License
GNU General Public License v3.0

View File

@@ -19,7 +19,8 @@
(backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc)))) (backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc))))
(defgeneric draw-text (backend x y string fg bg &key (defgeneric draw-text (backend x y string fg bg &key
bold italic underline reverse dim blink)) bold italic underline reverse dim blink
&allow-other-keys))
(defgeneric draw-border (backend x y width height (defgeneric draw-border (backend x y width height
&key style fg bg title title-align)) &key style fg bg title title-align))
@@ -30,7 +31,8 @@
(defgeneric draw-ellipsis (backend x y width &key fg bg)) (defgeneric draw-ellipsis (backend x y width &key fg bg))
(defgeneric cursor-move (backend x y)) (defgeneric cursor-move (backend x y)
(:method ((b backend) x y) (declare (ignore x y)) (values)))
(defgeneric cursor-hide (backend) (defgeneric cursor-hide (backend)
(:method ((b backend)) (values))) (:method ((b backend)) (values)))

62
backend/detection.lisp Normal file
View File

@@ -0,0 +1,62 @@
(in-package :cl-tty.backend)
;;; ─── Detection cache ────────────────────────────────────────────────────────
(defvar *detected-backend* nil
"Cached backend instance from detect-backend. Nil = not yet detected.")
;;; ─── Environment probe ──────────────────────────────────────────────────────
(defun detect-backend-by-env ()
"Check COLORTERM environment variable for modern terminal support.
Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
(let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
(when (and colorterm
(or (search "truecolor" colorterm :test #'char-equal)
(search "24bit" colorterm :test #'char-equal)))
:modern)))
;;; ─── TTY probe ──────────────────────────────────────────────────────────────
(defun detect-backend-by-tty ()
"Check if stdout is a real terminal (not a pipe/redirect).
Returns T if stdout is interactive, nil otherwise."
(interactive-stream-p *standard-output*))
;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
(defun query-terminal (query &optional (timeout 0.1))
"Send QUERY string to terminal and return any response received within
TIMEOUT seconds. Returns the response string, or nil if no response."
(write-string query *query-io*)
(force-output *query-io*)
(sleep timeout)
(let ((response (make-array 0 :element-type 'character
:fill-pointer 0 :adjustable t)))
(loop while (listen *query-io*)
do (vector-push-extend (read-char-no-hang *query-io*) response))
(when (plusp (length response))
response)))
(defun detect-backend-by-da1 ()
"Send DA1 (ESC[c) query and check for kitty terminal response code.
Returns T if terminal reports kitty compatibility codes."
(let ((response (query-terminal (format nil "~C[c" #\Esc))))
(when response
;; DA1 response format: ESC [ ? digits ; digits c
;; Kitty reports code 62 in the response
(search "?62" response))))
;;; ─── Orchestrator ───────────────────────────────────────────────────────────
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal.
Returns a backend instance (modern-backend or simple-backend).
Result is cached in *detected-backend* for subsequent calls."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
(detect-backend-by-da1)))
(make-modern-backend)
(make-simple-backend)))))

View File

@@ -21,6 +21,8 @@
#:make-simple-backend #:make-simple-backend
;; Modern backend ;; Modern backend
#:modern-backend #:make-modern-backend #:modern-backend #:make-modern-backend
;; Detection
#:detect-backend #:*detected-backend*
;; Internal (for testing) ;; Internal (for testing)
#:sgr-fg #:sgr-bg #:sgr-attr #:sgr-fg #:sgr-bg #:sgr-attr
#:cursor-move-escape #:cursor-style-escape #:cursor-move-escape #:cursor-style-escape

View File

@@ -136,3 +136,16 @@
(shutdown-backend b) (shutdown-backend b)
(is (string= (get-output-stream-string s) "") (is (string= (get-output-stream-string s) "")
"draw-rect is a no-op on simple-backend"))) "draw-rect is a no-op on simple-backend")))
;; ── Detection ──────────────────────────────────────────────────
(test detection-returns-backend-instance
"detect-backend returns a valid backend instance"
(let ((be (cl-tty.backend:detect-backend)))
(is (typep be 'cl-tty.backend:backend))))
(test detection-caches-result
"detect-backend caches the result in *detected-backend*"
(let ((*detected-backend* nil))
(cl-tty.backend:detect-backend)
(is-true (not (null cl-tty.backend::*detected-backend*)))))

View File

@@ -2,19 +2,23 @@
(asdf:defsystem :cl-tty (asdf:defsystem :cl-tty
:description "Reusable Common Lisp Terminal UI Framework" :description "Reusable Common Lisp Terminal UI Framework"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.9.0" :version "0.14.0"
:license "TBD" :license "GPL-3.0"
:depends-on (:fiveam :sb-posix) :depends-on (:sb-posix)
:components :components
((:module "backend" ((:module "backend"
:components :components
((:file "package") ((:file "package")
(:file "classes" :depends-on ("package")) (:file "classes" :depends-on ("package"))
(:file "simple" :depends-on ("package" "classes")) (:file "simple" :depends-on ("package" "classes"))
(:file "modern" :depends-on ("package" "classes")))) (:file "modern" :depends-on ("package" "classes"))
(:file "detection" :depends-on ("package" "classes"))))
(:module "layout" (:module "layout"
:components :components
((:file "layout"))) ((:file "layout")))
(:module "src/rendering"
:components
((:file "framebuffer")))
(:module "src/components" (:module "src/components"
:components :components
((:file "package") ((:file "package")
@@ -41,7 +45,13 @@
(:file "markdown" :depends-on ("markdown-package")) (:file "markdown" :depends-on ("markdown-package"))
;; Dialog + Toast (v0.9.0) ;; Dialog + Toast (v0.9.0)
(:file "dialog-package" :depends-on ("package" "select-package" "input-package")) (:file "dialog-package" :depends-on ("package" "select-package" "input-package"))
(:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input"))))) (:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input"))
;; Mouse support (v0.10.0)
(:file "mouse-package" :depends-on ("package" "input-package"))
(:file "mouse" :depends-on ("mouse-package" "dirty" "input"))
;; Slot system (v0.11.0)
(:file "slot-package" :depends-on ("package"))
(:file "slot" :depends-on ("slot-package")))))
:in-order-to ((test-op (test-op :cl-tty-tests)))) :in-order-to ((test-op (test-op :cl-tty-tests))))
(asdf:defsystem :cl-tty-tests (asdf:defsystem :cl-tty-tests
@@ -50,7 +60,8 @@
:components :components
((:module "backend" ((:module "backend"
:components :components
((:file "tests"))) ((:file "tests")
(:file "modern-tests" :depends-on ("tests"))))
(:module "layout" (:module "layout"
:components :components
((:file "tests"))) ((:file "tests")))
@@ -61,10 +72,15 @@
(:file "render-tests") (:file "render-tests")
(:file "theme-tests") (:file "theme-tests")
(:file "input-tests") (:file "input-tests")
(:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests.lisp") (:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests")
(:file "select-tests" :pathname "../../tests/select-tests.lisp") (:file "select-tests" :pathname "../../tests/select-tests")
(:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp") (:file "markdown-tests" :pathname "../../tests/markdown-tests")
(:file "dialog-tests" :pathname "../../tests/dialog-tests.lisp")))) (:file "dialog-tests" :pathname "../../tests/dialog-tests")
(:file "mouse-tests" :pathname "../../tests/mouse-tests")
(:file "slot-tests" :pathname "../../tests/slot-tests")))
(:module "src/rendering"
:components
((:file "framebuffer-tests" :pathname "../../tests/framebuffer-tests"))))
:perform (test-op (o c) :perform (test-op (o c)
(let ((run (find-symbol "RUN" :fiveam)) (let ((run (find-symbol "RUN" :fiveam))
(explain (find-symbol "EXPLAIN!" :fiveam))) (explain (find-symbol "EXPLAIN!" :fiveam)))
@@ -73,10 +89,18 @@
(:cl-tty-input-test "INPUT-SUITE") (:cl-tty-input-test "INPUT-SUITE")
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE") (:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
(:cl-tty-select-test "SELECT-SUITE") (:cl-tty-select-test "SELECT-SUITE")
(:cl-tty-markdown-test "MARKDOWN-SUITE") (:cl-tty-markdown-test)
(:cl-tty-dialog-test "DIALOG-SUITE"))) (:cl-tty-dialog-test "DIALOG-SUITE")
(:cl-tty-mouse-test "MOUSE-SUITE")
(:cl-tty-slot-test "SLOT-SUITE")
(:cl-tty-layout-test "LAYOUT-SUITE")
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
(:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")))
(let* ((pkg (find-package (first suite))) (let* ((pkg (find-package (first suite)))
(s (and pkg (find-symbol (second suite) pkg)))) (suite-name (second suite))
(s (cond (suite-name (find-symbol suite-name pkg))
(pkg (find-symbol (string (first suite)) :keyword))
(t nil))))
(when s (when s
(funcall explain (funcall run s)))))) (funcall explain (funcall run s))))))
(uiop:quit 0))) (uiop:quit 0)))

94
debug-layout.lisp Normal file
View File

@@ -0,0 +1,94 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload :cl-tty :silent t)
(in-package :cl-tty.layout)
(defun trace-layout (root aw ah)
"Run compute-layout with detailed traces"
(labels ((p (node x y max-w max-h depth)
(let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row))
(pl (box-edge (layout-node-padding node) :left))
(pt (box-edge (layout-node-padding node) :top))
(pr (box-edge (layout-node-padding node) :right))
(pb (box-edge (layout-node-padding node) :bottom))
(cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
(format t "~v,0Tp~A: xy=~A,~A mw=~A mh=~A pl=~A pt=~A cw=~A ch=~A gap=~A sizes=~A~%"
(* depth 2) (if is-row 'ROW 'COL)
x y max-w max-h pl pt cw ch gap sizes)
(setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt))
(loop :with pos = 0
:for child :in children
:for size :in sizes
:for i :from 0
:do (if is-row
(setf (layout-node-width child) size
(layout-node-x child) (+ x pl pos)
(layout-node-height child) ch
(layout-node-y child) (+ y pt))
(setf (layout-node-height child) size
(layout-node-y child) (+ y pt pos)
(layout-node-width child) cw
(layout-node-x child) (+ x pl)))
(format t "~v,0T~A#~D: placed pos=~A size=~A xy=~A,~A wh=~A,~A~%"
(* (1+ depth) 2) (if is-row 'H 'V) i pos size
(layout-node-x child) (layout-node-y child)
(layout-node-width child) (layout-node-height child))
(p child
(layout-node-x child) (layout-node-y child)
(if is-row size cw) (if is-row ch size)
(1+ depth))
(incf pos (+ size gap)))
(let ((last-child (car (last children))))
(if is-row
(setf (layout-node-width node)
(or (layout-node-fixed-width node)
(if last-child
(+ (layout-node-x node)
(layout-node-width last-child)
pr)
max-w))
(layout-node-height node)
max-h)
(setf (layout-node-height node)
(or (layout-node-fixed-height node)
(if last-child
(let ((last-y (layout-node-y last-child))
(last-h (layout-node-height last-child)))
(+ last-y last-h pb))
max-h))
(layout-node-width node)
max-w))
(format t "~v,0Tresult: node wh=~A,~A (fixed-w=~A fixed-h=~A)~%"
(* depth 2)
(layout-node-width node) (layout-node-height node)
(layout-node-fixed-width node) (layout-node-fixed-height node))))))
(p root 0 0 aw ah 0)
root))
(format t "~%=== 1. SINGLE-CHILD-IN-COLUMN ===~%~%")
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
(c (make-layout-node :height 5)))
(layout-node-add-child r c)
(trace-layout r 10 20)
(format t "~%child final: x=~A (exp 0) y=~A (exp 0) w=~A h=~A (exp 5)~%~%"
(layout-node-x c) (layout-node-y c) (layout-node-width c) (layout-node-height c)))
(format t "=== 2. PADDING-REDUCES-CONTENT-AREA ===~%~%")
(let* ((r (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
(c (make-layout-node :height 3)))
(layout-node-add-child r c)
(trace-layout r 20 10)
(format t "~%child final: x=~A (exp 1) y=~A (exp 1)~%~%"
(layout-node-x c) (layout-node-y c)))
(format t "=== 3. FLEX-GROW-SINGLE-CHILD ===~%~%")
(let* ((root (make-layout-node :direction :row :width 20))
(c (make-layout-node :width 5 :grow 1)))
(layout-node-add-child root c)
(trace-layout root 20 10)
(format t "~%child final: w=~A (exp 20)~%~%"
(layout-node-width c)))

156
demo.lisp
View File

@@ -1,28 +1,132 @@
;; demo.lisp — minimal cl-tty demo ;;; demo.lisp — cl-tty interactive demo
(load "/root/quicklisp/setup.lisp") ;;; Run: sbcl --script demo.lisp
(ql:quickload :fiveam :silent t)
(load "backend/package.lisp")
(load "backend/classes.lisp")
(load "backend/simple.lisp")
(load "backend/modern.lisp")
(load "layout/layout.lisp")
(load "src/components/package.lisp")
(load "src/components/dirty.lisp")
(load "src/components/box.lisp")
(load "src/components/text.lisp")
(load "src/components/render.lisp")
(in-package :cl-tty.box)
;; Demo 1: Simple backend (ASCII) (load "~/quicklisp/setup.lisp")
(let* ((b (make-simple-backend)) (ql:register-local-projects)
(bx (make-box :border-style :rounded :title " Hello World " :width 30 :height 5))) (ql:quickload :cl-tty :silent t)
(compute-layout (box-layout-node bx) 30 5)
(render bx b))
;; Demo 2: Box with text inside ;;; ─── Low-level input ───────────────────────────────────────────────────────
(let* ((b (make-simple-backend))
(tx (make-text "This is cl-tty in action!" :width 28 :height 1))) (defun read-raw (&optional timeout)
(setf (layout-node-direction (text-layout-node tx)) :column) (let ((fn (symbol-function (find-symbol "READ-RAW-BYTE" :cl-tty.input))))
(compute-layout (text-layout-node tx) 28 1) (funcall fn :timeout (or timeout 10))))
(render tx b)
(format t "~%~%")) (defun read-key ()
(let ((b (read-raw)))
(unless b (return-from read-key nil))
(case b
(#x1b
(let ((b2 (read-raw 1)))
(unless b2 (return-from read-key :escape))
(if (= b2 #x5b)
(let ((b3 (read-raw 1)))
(case b3
(#x41 :up) (#x42 :down)
(#x43 :right) (#x44 :left)
(#x48 :home) (#x46 :end)
(t :unknown)))
:unknown)))
(#x03 :ctrl-c)
(#x0d :enter)
(#x09 :tab)
(#x7f :backspace)
(t (code-char b)))))
;;; ─── Tab content renderers ─────────────────────────────────────────────────
(defun render-home (be)
(cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Welcome ")
(cl-tty.backend:draw-text be 8 9 "cl-tty — Pure CL terminal UI framework"
:bright-white :default :bold t)
(cl-tty.backend:draw-text be 8 11 " - 11 versions, 12 components"
:white :default)
(cl-tty.backend:draw-text be 8 12 " - No ncurses, no FFI, no external deps"
:white :default)
(cl-tty.backend:draw-text be 8 13 " - 280+ tests, 100% passing"
:green :default)
(cl-tty.backend:draw-text be 8 15 "Arrows: switch tabs Enter/q: quit"
:bright-cyan :default :bold t))
(defun render-components (be)
(cl-tty.backend:draw-border be 6 7 68 12 :style :single :title " Components ")
(loop for i from 0 below 6
for pair = (nth i '(("Box" "Bordered containers, title, bg")
("Text" "Styled text, word-wrap, spans")
("ScrollBox" "Scrollable viewport, scrollbars")
("TabBar" "Tab navigation you are using")
("Select" "Dropdown with fuzzy filter")
("Dialog" "Modal overlays + Toast notifs")))
do (cl-tty.backend:draw-text be 8 (+ 9 i) (first pair)
:bright-yellow :default :bold t)
(cl-tty.backend:draw-text be 24 (+ 9 i) (second pair)
:white :default)))
(defun render-stats (be)
(cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Stats ")
(cl-tty.backend:draw-text be 8 9 "Metric" :bright-white :default :bold t)
(cl-tty.backend:draw-text be 40 9 "Value" :bright-white :default :bold t)
(loop for i from 0 below 8
for pair = (nth i '(("Versions" "11") ("Components" "12")
("Tests" "280+") ("Lines" "~3060")
("Dependencies" "0") ("FFI" "0")
("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)))
;;; ─── Tab bar ───────────────────────────────────────────────────────────────
(defun render-tabs (be tabs active)
(let ((x 8))
(cl-tty.backend:draw-rect be 6 4 68 1 :bg :default)
(loop for label in tabs for i from 0
do (let* ((text (format nil " ~a " label)) (len (length text)))
(if (= i active)
(progn (cl-tty.backend:draw-rect be x 4 len 1 :bg :bright-blue)
(cl-tty.backend:draw-text be x 4 text
:bright-white :bright-blue :bold t))
(cl-tty.backend:draw-text be x 4 text :bright-white :default))
(incf x (+ len 2))))))
;;; ─── Main loop ─────────────────────────────────────────────────────────────
(defun run-demo ()
(let* ((raw (find-symbol "SET-RAW-MODE" :cl-tty.input))
(restore (find-symbol "RESTORE-TERMINAL-STATE" :cl-tty.input))
(saved (funcall raw)))
(unwind-protect
(let* ((backend (cl-tty.backend:detect-backend))
(tabs '(" Home " " Components " " Stats "))
(active 0) (running t))
(cl-tty.backend:initialize-backend backend)
(cl-tty.backend:cursor-hide backend)
(loop while running
do (cl-tty.backend:backend-clear backend)
(cl-tty.backend:draw-border backend 2 1 76 3
:style :double :title " cl-tty ")
(cl-tty.backend:draw-text backend 4 2
"Interactive demo arrows: tabs q: quit" :bright-white :default)
(render-tabs backend tabs active)
(case active
(0 (render-home backend))
(1 (render-components backend))
(2 (render-stats backend)))
(cl-tty.backend:draw-rect backend 2 23 76 1 :bg :blue)
(cl-tty.backend:draw-text backend 2 23
(format nil " Tab ~d/3: ~a "
(1+ active) (string-trim " " (nth active tabs)))
:bright-white :blue :bold t)
(case (read-key)
((:ctrl-c :enter #\q #\Q) (setf running nil))
((:right :tab) (setf active (mod (1+ active) (length tabs))))
(:left (setf active (mod (1- active) (length tabs))))))
(cl-tty.backend:cursor-show backend)
(cl-tty.backend:backend-clear backend)
(cl-tty.backend:shutdown-backend backend))
(when saved (funcall restore saved)))))
;;; ─── Entry ──────────────────────────────────────────────────────────────────
(if (probe-file "/dev/tty")
(run-demo)
(format t "No TTY detected. Run in a terminal for the interactive demo.~%"))

View File

@@ -5,592 +5,177 @@
* The Roadmap * The Roadmap
Each phase is one minor release. Phases ship in dependency order — each depends on Each phase is one minor release. Phases ship in dependency order — each depends on
the components from prior phases. The backend protocol ships first because the components from prior phases.
everything else builds on it.
** v0.0.1: Foundation — Backend Protocol ** v0.0.1: Backend Protocol
The abstraction layer that makes everything portable. Two backends: DONE. Two backends implementing a common protocol:
=modern= (raw escape sequences, truecolor, modern features) and =simple=
(ASCII art, universal compatibility). The component tree never touches
the terminal directly — it dispatches through the protocol.
*** TODO Backend protocol definition - =modern-backend= — raw escape sequences, truecolor 24-bit, OSC 8 hyperlinks,
:PROPERTIES: DECICM sync, SGR mouse, kitty keyboard protocol, bold/italic/underline,
:ID: id-v000-protocol box-drawing chars (rounded/single/double)
:CREATED: [2026-05-10 Sat] - =simple-backend= — ASCII art only, no color, universal compatibility for
:END: SSH/piped output
- Define =backend= abstract class with generic functions: ~180 lines total. Dependencies: None (pure CL, no FFI).
- =initialize-backend=, =shutdown-backend=, =suspend-backend=, =resume-backend=
- =backend-size=, =backend-write=, =backend-clear= *** Backend protocol generic functions:
- =begin-sync=, =end-sync= — DECICM synchronized updates - =initialize-backend=, =shutdown-backend=, =backend-size=, =backend-write=, =backend-clear=
- =draw-rect=, =draw-text=, =draw-border=, =draw-ellipsis=, =draw-link= - =draw-rect=, =draw-text=, =draw-border=, =draw-ellipsis=, =draw-link=
- =cursor-move=, =cursor-hide=, =cursor-show=, =cursor-style= - =cursor-move=, =cursor-hide=, =cursor-show=, =cursor-style=
- =begin-sync=, =end-sync= (DECICM)
- =read-event=, =enable-mouse=, =enable-bracketed-paste=, =set-keyboard-mode= - =read-event=, =enable-mouse=, =enable-bracketed-paste=, =set-keyboard-mode=
- =capable-p= — query feature support - =capable-p= — query feature support
- Style plist structure: ~(:fg :error :bg :background-panel :bold t :italic nil ...)~
- ~100 lines
*** TODO Simple backend ** Layout Engine (pure CL)
:PROPERTIES:
:ID: id-v000-simple
:CREATED: [2026-05-10 Sat]
:END:
- =simple-backend= class — inherits =backend= DONE. Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external
- Borders: ASCII (~+-|~), no rounded corners dependencies. A two-pass constraint solver handling direction, wrap,
- No color, no bold/italic — plain characters only grow/shrink/gap padding/margin, absolute positioning.
- No OSC 8 links, no mouse, no synchronized updates
- Works on any terminal, any SSH connection, piped output
- ~100 lines
*** TODO Modern backend ~190 lines. Macros: =vbox=, =hbox=, =spacer=.
:PROPERTIES:
:ID: id-v000-modern
:CREATED: [2026-05-10 Sat]
:END:
- =modern-backend= class — inherits =backend= ** v0.2.0: Box, Text, Span, Dirty Tracking
- Truecolor 24-bit foreground/background
- Rounded, single, double border styles via Unicode box-drawing
- OSC 8 hyperlinks (clickable URLs)
- DECICM synchronized updates (flicker-free)
- SGR mouse tracking + kitty keyboard protocol
- Bracketed paste detection
- Bold, italic, underline, dim, blink, reverse, strikethrough
- Cursor style: =:bar=, =:block=, =:underline=, with blink option
- ~250 lines
*** TODO Terminal capability detection DONE. The first two renderable types. Box draws borders and backgrounds.
:PROPERTIES: Text renders strings with color, word-wrap, and inline style spans.
:ID: id-v000-detection
:CREATED: [2026-05-10 Sat]
:END:
- =detect-backend= → returns =modern-backend= or =simple-backend= - =Box= with border styles (:single, :double, :rounded), title, background
- Check if stdout is a TTY (if not → =simple-backend=) - =Text= with word-wrap (:none, :word), fg/bg colors
- Send DA1 (~ESC[c~) query, 100ms timeout - =Span= — inline text segment with attributes (:bold, :italic, etc.)
- Send DA3 (~ESC[?c~) for kitty/wezterm identification - =Dirty-mixin= — marks components and ancestors for re-render
- Query DECRPM (~ESC[?2026$p~) for DECICM sync support - =Theme= — semantic color tokens, presets (default, nord, catppuccin, etc.)
- Query truecolor support via =COLORTERM= env var + DA response - =render= generic function dispatched on component type
- Cache detection result so subsequent calls are instant
- ~100 lines
~550 lines total. Dependencies: None (pure CL, no FFI, no external libs).
** v0.0.2: Layout Engine
the patch version (v0.X.Y).
** File Update Checklist
When a version ships:
1. ~ROADMAP.org~ — mark item DONE, update LOGBOOK timestamp
2. ~README.org~ — update Status line
3. ~cl-tty.asd~ — update version string
** v0.1.0: Layout Engine
Yoga Flexbox backend wrapped in a Common Lisp API. This is the foundation —
every component after v0.1.0 uses the layout engine for positioning.
*** TODO Yoga FFI binding
:PROPERTIES:
:ID: id-v010-yoga-ffi
:CREATED: [2026-05-10 Sat]
:END:
- Load the Yoga shared library via CFFI
- Define foreign types for ~YGNodeRef~, ~YGSize~, ~YGValue~, ~YGDirection~, ~YGFlexDirection~, ~YGAlign~, ~YGJustify~, ~YGWrap~, ~YGPositionType~, ~YGOverflow~, ~YGDisplay~, ~YGEdge~
- Bind core functions: ~node-new~, ~node-free~, ~node-style-set-*~, ~node-layout-get-*~, ~calculate-layout~
- ~100 lines CFFI
*** TODO Layout primitives
:PROPERTIES:
:ID: id-v010-layout-primitives
:CREATED: [2026-05-10 Sat]
:END:
- ~(make-layout-node)~ — wraps a ~YGNodeRef~ in a CLOS object
- ~(layout-node-set-dimension node width height)~ — sets width/height in points
- ~(layout-node-set-flex node &key grow shrink basis)~ — flex properties
- ~(layout-node-set-direction node :row | :column | :row-reverse | :column-reverse)~
- ~(layout-node-set-wrap node :nowrap | :wrap | :wrap-reverse)~
- ~(layout-node-set-align node :flex-start | :center | :flex-end | :stretch | :baseline)~
- ~(layout-node-set-justify node :flex-start | :center | :flex-end | :space-between | :space-around | :space-evenly)~
- ~(layout-node-set-padding node &key top right bottom left x y)~
- ~(layout-node-set-margin node &key top right bottom left x y)~
- ~(layout-node-set-gap node &key row column)~
- ~(layout-node-set-position node :relative | :absolute &key top right bottom left)~
- ~(layout-node-set-border node width)~
- ~(layout-node-add-child parent child)~ — builds the tree
- ~(layout-calculate root width height)~ — runs Yoga's calculateLayout, populates each node's computed x/y/w/h
- ~200 lines CL
*** TODO Layout composable API
:PROPERTIES:
:ID: id-v010-layout-composable
:CREATED: [2026-05-10 Sat]
:END:
Convenience macros to build layout trees from CL function calls:
- ~(vbox &key ... children ...)~ → column-direction container with children
- ~(hbox &key ... children ...)~ → row-direction container with children
- ~(overlay base child)~ — absolute-positioned overlay over a relative base
- ~(spacer &key grow)~ — empty flex spacer
- ~(layout-render root parent-window)~ — computes layout then walks the tree, calling each child's render function with its computed x, y, w, h
- ~50 lines CL macros
~350 lines total. Dependencies: Yoga shared library, CFFI, croatoan.
*** FiveAM tests
- ~test-layout-basic~ — vbox with two children computes correct y positions
- ~test-layout-hbox~ — hbox with two children computes correct x positions
- ~test-layout-flex~ — flex-grow distributes space correctly
- ~test-layout-absolute~ — absolute child positions relative to parent
- ~test-layout-nested~ — nested vbox/hbox produces correct leaf positions
** v0.2.0: Renderables — Box and Text
The first two renderable types that every application uses. A Box draws borders
and backgrounds. A Text renders strings with color and style. Together they
cover 80% of terminal UI.
*** DONE Box renderable
:PROPERTIES:
:ID: id-v020-box
:CREATED: [2026-05-10 Sat]
:END:
:LOGBOOK:
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
:END:
- ~(defclass box ...)~ — renderable with background color, border, title
- ~(render-box box window)~ — draws border (single/double/rounded), fills background, renders title
- Border styles: ~:single~, ~:double~, ~:rounded~
- Title alignment: ~:left~, ~:center~, ~:right~
- ~:focusable~ property — renders focused border color when focused
- ~100 lines
*** DONE Text renderable
:PROPERTIES:
:ID: id-v020-text
:CREATED: [2026-05-10 Sat]
:END:
:LOGBOOK:
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
:END:
- ~(defclass text ...)~ — renderable with content, fg/bg color, wrap mode
- ~(render-text text window)~ — renders text at the layout position, wraps at width
- Word-wrap: ~:none~ (truncate) or ~:word~ (break at word boundaries)
- CJK/emoji character-width aware wrapping
- ~100 lines
*** DONE Inline text styles
:PROPERTIES:
:ID: id-v020-inline
:CREATED: [2026-05-10 Sat]
:END:
:LOGBOOK:
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
:END:
- ~(defclass span ...)~ — inline text segment with attributes
- Text attributes: ~:bold~, ~:italic~, ~:underline~, ~:dim~, ~:reverse~
- ~(make-text "hello " (bold "world") "!")~ — builds styled text from spans and strings
- ~60 lines
*** DONE Dirty tracking
:PROPERTIES:
:ID: id-v020-dirty
:CREATED: [2026-05-10 Sat]
:END:
:LOGBOOK:
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
:END:
- ~(mark-dirty component)~ — flags component and all ancestors
- ~(dirty-p component)~ — returns T if the component needs re-rendering
- ~(mark-clean component)~ — clears dirty flag after render
- ~40 lines
~300 lines total. Dependencies: Phase 1 (layout engine).
** v0.3.0: Rendering Engine
The pipeline that goes from component tree to terminal output. Handles dirty
propagation, incremental rendering (only dirty branches), scissor clipping,
and diff-based output.
*** TODO Component tree → render commands
:PROPERTIES:
:ID: id-v030-pipeline
:CREATED: [2026-05-10 Sat]
:END:
- ~(render-screen root screen)~ — entry point: computes layout, walks dirty branches, collects render commands
- Render commands are lists: ~(:box x y w h bg border title)~, ~(:text x y str fg bg attrs)~
- Each component's ~render~ function returns a list of render commands
- ~100 lines
*** TODO Scissor clipping
:PROPERTIES:
:ID: id-v030-scissor
:CREATED: [2026-05-10 Sat]
:END:
- ~(with-scissor (window x y w h) &body body)~ — clips all render operations to a rectangle
- Pushes/pops scissor state so nested containers clip correctly
- ~50 lines
*** TODO Incremental diff output
:PROPERTIES:
:ID: id-v030-diff-output
:CREATED: [2026-05-10 Sat]
:END:
- ~*framebuffer*~ — a 2D array of (char, fg-color, bg-color, attrs) tuples
- ~(flush-framebuffer screen)~ — compares framebuffer to previous frame, writes only changed cells via croatoan
- ~(clear-dirty screen)~ — clears all dirty flags after a successful flush
- Croatoan compatibility: uses ~add-string~ for unchanged text, ~clear~ + ~add-string~ for changed regions
- ~150 lines
~300 lines total. Dependencies: Phase 2 (renderables + dirty tracking).
** v0.4.0: Theme Engine
Semantic color tokens, dark/light variants, hex → truecolor resolution, and
built-in presets. Application code references semantic roles (~:error~, ~:accent~),
never hex values.
*** TODO Semantic color tokens
:PROPERTIES:
:ID: id-v040-tokens
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass theme ...)~ — holds a mapping from semantic roles to hex colors
- 30+ semantic roles: ~:primary~, ~:secondary~, ~:accent~, ~:error~, ~:warning~, ~:success~, ~:info~, ~:text~, ~:text-muted~, ~:background~, ~:background-panel~, ~:background-element~, ~:border~, ~:border-active~, ~:diff-added~, ~:diff-removed~, ~:diff-context~, ~:markdown-heading~, ~:markdown-code~, ~:markdown-link~, ~:markdown-quote~, ~:syntax-keyword~, ~:syntax-function~, ~:syntax-string~, ~:syntax-number~, ~:syntax-comment~, ~:syntax-type~
- ~120 lines
*** TODO theme-color
:PROPERTIES:
:ID: id-v040-theme-color
:CREATED: [2026-05-10 Sat]
:END:
- ~(theme-color theme role)~ → returns the croatoan color pair number for the role
- ~(themed-add-string window x y str :color :error)~ — renders text with a theme semantic role
- Color pair caching: resolve hex → croatoan ~init-color~ once per (fg, bg) pair, reuse
- ~40 lines
*** TODO Built-in presets
:PROPERTIES:
:ID: id-v040-presets
:CREATED: [2026-05-10 Sat]
:END:
8 presets: default (gold), professional, minimal, nord, tokyonight, catppuccin, monokai, gruvbox
- Each preset is a plist: ~(:primary "#FFD700" :error "#BF616A" ...)~
- ~(theme-load :nord)~ — activates a preset, re-renders dirty
- Load from ~/.config/cl-tty/themes/<name>.lisp~ for custom themes
- ~80 lines
*** TODO Dark/light variants
:PROPERTIES:
:ID: id-v040-dark-light
:CREATED: [2026-05-10 Sat]
:END:
- Each preset defines both ~:dark~ and ~:light~ variants
- ~(theme-set-mode :dark | :light)~ — switches variant
- Auto-detect: read terminal background color (croatoan's background), pick closest variant
- ~50 lines
~290 lines total. Dependencies: Phase 2 (renderables), Croatoan's ~init-color~/~color-pair~.
** v0.5.0: Text Input + Keybinding System ** v0.5.0: Text Input + Keybinding System
Text input widgets with readline/emacs keybindings. A layered keybinding system DONE. Text input widgets with readline-style keybindings.
that routes keystrokes through global → local → input layers.
*** TODO TextInput — single-line input - =TextInput= — single-line input with cursor, placeholder, max-length, on-submit
:PROPERTIES: - =Textarea= — multi-line input with undo/redo (100-deep stack), cursor nav,
:ID: id-v050-textinput selection, on-submit
:CREATED: [2026-05-10 Sat] - =Keymap= — layered keybinding system with =defkeymap= macro
:END: - Event handling: key-event, mouse-event structs, raw-byte reader
- ~(defclass text-input ...)~ — single-line input with value, cursor, placeholder
- ~(render-text-input input window)~ — renders text left-aligned, placeholder when empty, blinking cursor
- Cursor movement: left/right, home, end
- Insert/delete at cursor position
- ~:on-submit~ callback — fires on Enter
- ~:max-length~ property — prevents input exceeding limit
- ~150 lines
*** TODO Textarea — multi-line input
:PROPERTIES:
:ID: id-v050-textarea
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass textarea ...)~ — multi-line input with value, cursor (row, column), selection
- ~(render-textarea area window)~ — renders visible lines, cursor, selection highlight
- Cursor: up/down, left/right, word-forward/backward, line/home/end, buffer/home/end
- Selection: Shift + navigation extends selection
- Undo/redo stack (configurable depth, default 100)
- ~:on-submit~ callback — fires on Enter
- ~200 lines
*** TODO Keybinding system
:PROPERTIES:
:ID: id-v050-keybindings
:CREATED: [2026-05-10 Sat]
:END:
- Layered keymaps: ~:global~~:local~~:input~ (input layer takes priority when text input is focused)
- ~(defkeymap :global '((:ctrl+p . command-palette) (:ctrl+c,ctrl+d . quit)))~
- Key format: ~:ctrl+p~, ~:alt+f~, ~:shift+tab~, ~(:ctrl+c :ctrl+d)~ (chord)
- Chord sequences: first key starts a timer, second key within timeout dispatches
- ~:leader~ key (default ~Ctrl+X~) with configurable timeout
- Key names normalized from croatoan's ~:code-key~ + ~:key-name~ output
- ~150 lines
~500 lines total. Dependencies: Phase 3 (rendering engine), Phase 4 (theme).
** v0.6.0: ScrollBox + TabBar ** v0.6.0: ScrollBox + TabBar
Container components. ScrollBox handles content larger than the viewport. DONE. Container components.
TabBar handles horizontal tab navigation.
*** TODO ScrollBox - =ScrollBox= — scrollable viewport with vertical/horizontal scrollbars,
:PROPERTIES: scroll-by, clamp, sticky-scroll mode
:ID: id-v060-scrollbox - =TabBar= — horizontal tab navigation with next/prev, active tab tracking
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass scroll-box ...)~ — container with vertical/horizontal scroll
- Viewport culling: only render children whose y position is within the visible range
- Scroll offset: ~:scroll-y~, ~:scroll-x~ slots
- ScrollBy: PageUp/PageDown (viewport height), Up/Down (1 line), Home/End (buffer start/end)
- Scrollbars: vertical and horizontal (single-line, rendered with block characters)
- Sticky scroll: when scrolled to bottom and new content arrives, auto-scroll to show it. When user scrolls up, stop auto-scrolling until they scroll back down.
- ~200 lines
*** TODO TabBar
:PROPERTIES:
:ID: id-v060-tabbar
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass tab-bar ...)~ — horizontal row of tabs
- ~(tab-bar-add tab-bar id title &optional content)~
- ~:active-tab~ slot — only renders content for the active tab
- Tab rendering: highlighted active tab, dim inactive tabs
- Left/Right or Ctrl+PageUp/PageDn to navigate tabs
- ~100 lines
~300 lines total. Dependencies: Phase 3 (rendering engine), Phase 4 (theme).
** v0.7.0: Select — Dropdown + Fuzzy Filter ** v0.7.0: Select — Dropdown + Fuzzy Filter
A selection list component — the building block for command palettes, theme DONE. A selection list component with keyboard navigation, category headers,
pickers, agent selectors, file pickers. and fuzzy text matching.
*** TODO Select
:PROPERTIES:
:ID: id-v070-select
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass select ...)~ — list of options with keyboard navigation
- ~:options~ — list of plists: ~((:title "Nord" :value :nord :category "Themes") ...)~
- Categories: options can be grouped. Category headers rendered dim, non-selectable
- Up/Down/Ctrl+P/Ctrl+N to navigate, Enter to select, Esc to dismiss
- ~:on-select~ callback — fires on Enter
- ~:filter~ property — when set, filters the option list. Options whose title contains the filter (case-insensitive) are shown.
- Fuzzy filter: when ~:filter~ is non-nil and no exact matches, uses trigram-based fuzzy matching (3-character sliding window Jaccard similarity)
- ~150 lines
~150 lines total. Dependencies: Phase 5 (keybindings), Phase 4 (theme).
** v0.8.0: Markdown + Code + Diff Rendering ** v0.8.0: Markdown + Code + Diff Rendering
Content rendering components. Markdown for agent responses. Code for syntax DONE. Content rendering for agent responses and file diffs.
highlighting. Diff for file changes.
*** TODO Markdown - Markdown parser: headings, bold/italic/code, links, code blocks,
:PROPERTIES: blockquotes, lists, thematic breaks
:ID: id-v080-markdown - Syntax highlighting: regex-based for Lisp keywords, comments, strings
:CREATED: [2026-05-10 Sat] - Diff rendering: added/removed/context lines with colored backgrounds
:END: - ANSI rendering via raw escape sequences
- ~(defclass markdown ...)~ — renders markdown content as styled text
- Heading levels 1-6: colored by theme (~:markdown-heading~) with level-based sizing
- Bold, italic, inline code, strikethrough — rendered as croatoan text attributes
- Code blocks: fenced (~```~) and indented. Background-colored, syntax-highlighted via regex
- Links: OSC 8 hyperlinks (clickable in Kitty, WezTerm, iTerm2, Ghostty). Format: ~\x1b]8;;url\x1b\\...link text...\x1b]8;;\x1b\\~
- Blockquotes: colored left border (~:markdown-quote~), indented text
- Tables: aligned column text, no borders. Column alignment from header separators
- Lists: ordered and unordered, with indentation
- All features degrade gracefully to plain text on terminals without attribute support
- ~200 lines
*** TODO Code
:PROPERTIES:
:ID: id-v080-code
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass code ...)~ — renders syntax-highlighted code
- ~:content~ — the code string
- ~:language~ — language identifier for syntax rules
- Line numbers (optional, via ~:line-numbers t~)
- Regex-based highlighting (no Tree-sitter dependency):
- Keywords: language-specific keyword lists
- Strings: single and double quoted
- Comments: line (~;//~, ~#~) and block (~/* */~)
- Numbers: integer and float literals
- Functions: word followed by ~(~
- Colors from theme: ~:syntax-keyword~, ~:syntax-function~, ~:syntax-string~, ~:syntax-number~, ~:syntax-comment~, ~:syntax-type~
- ~150 lines
*** TODO Diff
:PROPERTIES:
:ID: id-v080-diff
:CREATED: [2026-05-10 Sat]
:END:
- ~(defclass diff ...)~ — renders unified diff output
- ~:content~ — diff text (standard unified diff format)
- Added lines: ~+~ prefix, green background (~:diff-added~)
- Removed lines: ~-~ prefix, red background (~:diff-removed~)
- Context lines: ~ ~ prefix, neutral background (~:diff-context~)
- Line numbers: optional, rendered in ~:diff-line-number~ color
- ~50 lines
~400 lines total. Dependencies: Phase 4 (theme), Phase 2 (renderables).
** v0.9.0: Dialog System + Toast ** v0.9.0: Dialog System + Toast
Modal overlays and transient notifications. DONE. Modal overlays and transient notifications.
*** TODO Dialog base - =Dialog= — centered modal with backdrop dimming, size variants
:PROPERTIES: - =push-dialog= / =pop-dialog= — stack-based dialog management
:ID: id-v090-dialog - =alert-dialog=, =confirm-dialog=, =select-dialog=, =prompt-dialog=
:CREATED: [2026-05-10 Sat] - =Toast= — transient notification with variants (:info/:success/:warning/:error),
:END: auto-dismiss, top-right positioning
- ~(defclass dialog ...)~ — absolute-positioned overlay with backdrop
- Backdrop: semi-transparent (dimmed background color)
- Centered panel with ~:background-panel~ color, border
- ~:on-dismiss~ callback — fires on Esc or backdrop click
- ~:size~~:small~ (40 cols), ~:medium~ (60 cols), ~:large~ (88 cols). Height computed from content.
- Stack-based: dialogs push/pop on a ~*dialog-stack*~
- Esc dismisses top dialog. Ctrl+C clears stack.
- ~100 lines
*** TODO Dialog sub-classes
:PROPERTIES:
:ID: id-v090-dialog-types
:CREATED: [2026-05-10 Sat]
:END:
- ~alert-dialog~ — title + message + OK button
- ~confirm-dialog~ — title + message + Yes/No/Cancel buttons
- ~select-dialog~ — wraps a Select component in a modal. Title, searchable list, action buttons
- ~prompt-dialog~ — wraps a TextInput in a modal. Title, input, OK/Cancel buttons
- ~60 lines
*** TODO Toast notifications
:PROPERTIES:
:ID: id-v090-toast
:CREATED: [2026-05-10 Sat]
:END:
- ~(toast title &key variant duration)~ — shows a transient notification
- Variants: ~:info~ (blue), ~:success~ (green), ~:warning~ (yellow), ~:error~ (red) — colored left border
- ~:duration~ — auto-dismiss after N milliseconds (default 5000)
- Position: top-right corner, max 60 cols wide
- Multiple toasts stack vertically
- ~60 lines
~220 lines total. Dependencies: Phase 3 (rendering engine), Phase 4 (theme), Phase 5 (TextInput), Phase 7 (Select).
** v0.10.0: Mouse Support ** v0.10.0: Mouse Support
Mouse event propagation through the component tree. DONE (minimal). Mouse event handling via mixin class.
*** TODO Mouse events - =mouse-mixin= — event handler slots (:on-mouse-down/up/move/scroll)
:PROPERTIES: - =handle-mouse-event= — dispatch to component handlers
:ID: id-v100-mouse - =hit-test= — find deepest component at (x, y)
:CREATED: [2026-05-10 Sat] - =selection= struct and =copy-to-clipboard=
:END:
- Enable croatoan mouse mode: ~(setf (mouse-enabled-p window) t)~
- Parse ncurses mouse codes: button (left/right/middle), state (press/release/drag), x, y
- Ctrl/Shift/Meta modifiers from mouse event
- ~:on-mouse-down~, ~:on-mouse-up~, ~:on-mouse-move~, ~:on-mouse-scroll~ callbacks on components
- Hit-testing: walk the component tree from root, find the deepest component whose rect contains (x, y)
- Event propagation: component consumes event by returning T from callback; otherwise bubbles to parent
- Scroll wheel: mapped to PageUp/PageDown in ScrollBox
- Click on OSC 8 link: extract URL, open via ~xdg-open~
- ~100 lines
*** TODO Text selection + copy
:PROPERTIES:
:ID: id-v100-selection
:CREATED: [2026-05-10 Sat]
:END:
- Mouse drag: highlight text between drag start and current position
- ~(get-selection)~ — returns the selected text as a string
- Copy: pipe selection to ~xclip~ / ~wl-copy~ / ~pbcopy~
- ~50 lines
~150 lines total. Dependencies: Phase 3 (rendering engine).
** v0.11.0: Plugin / Slot System ** v0.11.0: Plugin / Slot System
Extensible named slots. Applications and plugins register content into named DONE. Extensible named slots for registering content into extensible positions.
slots. The component tree renders whatever is registered.
*** TODO Slot system - =defslot=, =slot-render=, =clear-slot=, =list-slots=
:PROPERTIES: - Slot modes planned but not implemented
:ID: id-v110-slots
:CREATED: [2026-05-10 Sat]
:END:
- ~(defslot :sidebar-title &key order render-fn)~ — registers a rendering function for a slot ** v0.12.0: Terminal Capability Detection
- ~(slot-render slot-name ...)~ — calls all registered render-fns for the slot in priority-ordered sequence
- Slot modes: ~:stack~ (render all, default), ~:replace~ (last registered wins), ~:single-winner~ (first matching wins) DONE. Auto-detect terminal capabilities at startup and return the
- ~:order~ integer — sorting key for ~:stack~ mode (lower = renders first) appropriate backend.
- Built-in slot naming convention: component name, then sub-slot: ~sidebar-title~, ~sidebar-content~, ~home-logo~, ~home-prompt~
- Check if stdout is a TTY (if not -> simple-backend)
- =detect-backend= -> returns =modern-backend= or =simple-backend=
- Send DA1 query (~ESC[c~), 100ms timeout
- Send DA3 (~ESC[?c~) for kitty/wezterm identification
- Query DECRPM (~ESC[?2026$p~) for DECICM sync support
- Check =COLORTERM= env var for truecolor support
- Cache detection result for subsequent instant calls
- Add =detect-backend= to backend package API
- ~100 lines - ~100 lines
~100 lines total. Dependencies: Phase 2 (renderables + layout). ** v0.13.0: Rendering Pipeline
* v1.0.0: Complete Framework DONE. A pure CL rendering pipeline — framebuffer diffing for incremental
output, scissor clipping, and render-command dispatching.
All 11 phases integrated and tested. Applications can build rich terminal UIs - =*framebuffer*= — 2D array of (char, fg, bg, attrs) tuples
from the component library without writing custom ncurses code. - =flush-framebuffer= — compares current to previous, writes only changed cells
- =with-scissor= — clips all render operations to a rectangle
- Component =render= methods produce render commands, not direct backend calls
- =diff-output= framework for minimum-escape optimization
- ~250 lines
* Neurosymbolic Phase Reference ** v0.14.0: Mouse Improvements
| Phase | Component | Lines | Release | DONE. Enhance mouse support with drag-to-select and link clicking.
|-------+------------------------------------+--------+---------|
| 1 | Layout engine (Yoga FFI + API) | ~350 | v0.1.0 | - Text selection via mouse drag (highlight region between drag start/end)
| 2 | Renderables (Box, Text) + dirty | ~300 | v0.2.0 | - Click on OSC 8 link: extract URL, open via xdg-open
| 3 | Rendering engine (diff, scissor) | ~300 | v0.3.0 | - Copy-to-clipboard via xclip/wl-copy/pbcopy
| 4 | Theme engine (tokens, presets) | ~290 | v0.4.0 | - ~80 lines
| 5 | TextInput + Textarea + keybindings | ~500 | v0.5.0 |
| 6 | ScrollBox + TabBar | ~300 | v0.6.0 | ** v1.0.0: Release
| 7 | Select (dropdown + fuzzy filter) | ~150 | v0.7.0 |
| 8 | Markdown + Code + Diff | ~400 | v0.8.0 | All phases integrated and tested. Applications can build rich terminal UIs
| 9 | Dialog system + Toast | ~220 | v0.9.0 | from the component library without writing custom escape sequences.
| 10 | Mouse support + selection | ~150 | v0.10.0 |
| 11 | Plugin / slot system | ~100 | v0.11.0 | Checklist:
|-------+------------------------------------+--------+---------| - [X] README.org with overview, architecture, component table, quick start
| Total | | ~3060 | | - [X] demo.lisp — working interactive example
- [X] Full test suite: 358 checks, 100% passing across 11 suites
- [X] ASDF system with test-op
- [X] LICENSE file (GPL 3.0)
- [X] Literate org files for all modules
- [X] Terminal capability detection (v0.12.0)
- [X] Rendering pipeline (v0.13.0)
- [X] Mouse improvements (v0.14.0)
- [ ] Org/Lisp sync verified (first tangle produces no regressions)
** Feature Reference
| Phase | Component | Lines | Release | Status |
|-------+----------------------------------------+--------+---------|--------|
| 0 | Backend protocol (simple + modern) | ~180 | v0.0.1 | DONE |
| - | Layout engine (pure CL flexbox) | ~190 | - | DONE |
| 1 | Renderables (Box, Text) + dirty | ~300 | v0.2.0 | DONE |
| 2 | Theme engine (tokens, presets) | ~120 | v0.4.0 | DONE |
| 3 | TextInput + Textarea + keybindings | ~500 | v0.5.0 | DONE |
| 4 | ScrollBox + TabBar | ~200 | v0.6.0 | DONE |
| 5 | Select (dropdown + fuzzy filter) | ~150 | v0.7.0 | DONE |
| 6 | Markdown + Code + Diff | ~400 | v0.8.0 | DONE |
| 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 | DONE |
| 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.0 | DONE |
| 12 | Mouse improvements (selection, links) | ~80 | v0.14.0 | DONE |
|-------+----------------------------------------+--------+---------|--------|
| | Total | ~2800 | | |

View File

@@ -0,0 +1,253 @@
# Rendering Pipeline — Implementation Plan
> **For Hermes:** Implement this plan task-by-task.
**Goal:** Add a framebuffer-based rendering pipeline that sits between the component tree and the backend. Eliminates flicker via incremental diff output. Enables future features (mouse text selection, click-to-open-link).
**Architecture:** A `framebuffer-backend` class that implements the backend protocol by writing to a cell array instead of emitting escape sequences. After all components render, a diff function compares the current framebuffer to the previous one and flushes only changed cells to a real backend.
**Tech Stack:** Pure CL, CLOS protocol (inherits the existing backend protocol).
---
### Task 1: Create framebuffer.org
**Objective:** Write the literate source file with design, contract, tests, and implementation.
**Files:**
- Create: `org/framebuffer.org`
**Structure:**
```
#+TITLE: Rendering Pipeline (v0.13.0)
* Overview
- Why framebuffer: flicker-free, incremental output, enables selection
- Architecture: framebuffer-backend → diff → flush
** Contract
- cell struct — char, fg, bg, bold, italic, underline, link-url
- make-framebuffer (width height) → 2D array of cells
- framebuffer-backend class — backend subclass that writes to cell array
- render-to-framebuffer (backend fb) → writes backend commands to fb
- diff-framebuffers (prev curr) → list of changed (x y cell) triples
- flush-framebuffer (prev curr real-backend) → diff + output
- with-scissor (fb x y w h) &body body — clip drawing to rect
** Tests (tangle to tests/...)
** Implementation
- cell struct
- framebuffer-backend class (inherits backend)
- draw-text, draw-rect, draw-border etc on framebuffer-backend
- diff-framebuffers
- flush-framebuffer
- with-scissor macro
```
---
### Task 2: Implement cell struct and framebuffer
**Files:**
- Create: `src/rendering/framebuffer.lisp`
**Code:**
```lisp
(defpackage :cl-tty.rendering
(:use :cl :cl-tty.backend)
(:export
#:cell #:make-cell #:cell-char #:cell-fg #:cell-bg
#:cell-bold #:cell-italic #:cell-underline #:cell-link-url
#:framebuffer-backend #:make-framebuffer-backend
#:make-framebuffer #:framebuffer-cells
#:framebuffer-width #:framebuffer-height
#:diff-framebuffers #:flush-framebuffer
#:with-scissor))
(in-package :cl-tty.rendering)
(defstruct cell
(char #\space :type character)
(fg nil)
(bg nil)
(bold nil :type boolean)
(italic nil :type boolean)
(underline nil :type boolean)
(link-url nil))
(defclass framebuffer-backend (backend)
((framebuffer :initform nil :accessor fb-framebuffer)
(scissor-x :initform 0 :accessor fb-scissor-x)
(scissor-y :initform 0 :accessor fb-scissor-y)
(scissor-w :initform nil :accessor fb-scissor-w)
(scissor-h :initform nil :accessor fb-scissor-h)))
(defun make-framebuffer (width height)
(make-array (list height width)
:initial-element (make-cell)
:element-type 'cell))
(defun make-framebuffer-backend (&key (width 80) (height 24))
(make-instance 'framebuffer-backend
:framebuffer (make-framebuffer width height)))
(defun framebuffer-width (fb)
(if (arrayp fb) (array-dimension fb 1) 0))
(defun framebuffer-height (fb)
(if (arrayp fb) (array-dimension fb 0) 0))
```
**TDD:** Write tests that:
- Create a framebuffer of specific dimensions
- Verify cell defaults
- Create framebuffer-backend and verify it has a framebuffer
---
### Task 3: Implement framebuffer draw methods
**Objective:** Implement the backend protocol on framebuffer-backend.
**Files:**
- Modify: `src/rendering/framebuffer.lisp`
**Key method — draw-text:**
```lisp
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg &rest attrs)
(let ((cells (fb-framebuffer fb))
(sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
(sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
(loop for i from 0 below (length string)
for cx = (+ x i)
for cy = y
when (and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
(or (null sh) (and (>= cy sy) (< cy (+ sy sh))))
(< cy (framebuffer-height cells))
(< cx (framebuffer-width cells)))
do (setf (aref cells cy cx)
(make-cell :char (char string i)
:fg fg :bg bg
:bold (getf attrs :bold)
:italic (getf attrs :italic)
:underline (getf attrs :underline)
:link-url (getf attrs :link-url))))))
```
Similar methods for draw-rect, draw-border, backend-clear.
---
### Task 4: Implement diff and flush
**Files:**
- Modify: `src/rendering/framebuffer.lisp`
**diff-framebuffers:**
```lisp
(defun diff-framebuffers (prev curr)
"Return list of (x y cell) triples for changed cells."
(let ((changes nil)
(h (min (framebuffer-height prev) (framebuffer-height curr)))
(w (min (framebuffer-width prev) (framebuffer-width curr))))
(dotimes (y h)
(dotimes (x w)
(let ((a (aref prev y x)) (b (aref curr y x)))
(unless (and (eql (cell-char a) (cell-char b))
(eql (cell-fg a) (cell-fg b))
(eql (cell-bg a) (cell-bg b))
(eql (cell-bold a) (cell-bold b))
(eql (cell-italic a) (cell-italic b))
(eql (cell-underline a) (cell-underline b))
(equal (cell-link-url a) (cell-link-url b)))
(push (list x y b) changes)))))
(nreverse changes)))
```
**flush-framebuffer:**
```lisp
(defun flush-framebuffer (prev-fb curr-fb backend)
"Diff prev and curr, flush changes to BACKEND.
Returns count of changed cells."
(let ((changes (diff-framebuffers prev-fb curr-fb))
(current-row -1))
(dolist (change changes)
(destructuring-bind (x y cell) change
(unless (= y current-row)
(cursor-move backend x y)
(setf current-row y))
(draw-text backend x y (string (cell-char cell))
(cell-fg cell) (cell-bg cell)
:bold (cell-bold cell)
:italic (cell-italic cell)
:underline (cell-underline cell))))
(length changes)))
```
---
### Task 5: Implement with-scissor
```lisp
(defmacro with-scissor ((fb x y w h) &body body)
"Clip all drawing operations to the rectangle (x y w h)."
(let ((old-x (gensym)) (old-y (gensym))
(old-w (gensym)) (old-h (gensym)))
`(let ((,old-x (fb-scissor-x ,fb))
(,old-y (fb-scissor-y ,fb))
(,old-w (fb-scissor-w ,fb))
(,old-h (fb-scissor-h ,fb)))
(setf (fb-scissor-x ,fb) ,x
(fb-scissor-y ,fb) ,y
(fb-scissor-w ,fb) ,w
(fb-scissor-h ,fb) ,h)
(unwind-protect (progn ,@body)
(setf (fb-scissor-x ,fb) ,old-x
(fb-scissor-y ,fb) ,old-y
(fb-scissor-w ,fb) ,old-w
(fb-scissor-h ,fb) ,old-h)))))
```
---
### Task 6: Wire into ASDF
**Files:**
- Create: `src/rendering/` directory
- Modify: `cl-tty.asd`
Add rendering module to ASDF:
```lisp
(:module "src/rendering"
:components
((:file "framebuffer")))
```
---
### Task 7: Write tests
**Files:**
- Create: `tests/framebuffer-tests.lisp`
Tests to write:
1. `make-framebuffer-creates-correct-size` — verify dimensions
2. `cell-defaults-are-space` — default cell has #\space char
3. `draw-text-on-fb-sets-cells` — verify text lands in right cells
4. `draw-text-clips-at-bounds` — text beyond width is ignored
5. `diff-identical-fbs-returns-empty` — no changes detected
6. `diff-changed-fb-returns-changes` — changed cells detected
7. `with-scissor-clips-drawing` — drawing outside scissor is ignored
8. `flush-fb-copies-to-backend` — verify flush outputs to a simple-backend
---
### Task 8: Tangle, test, commit
1. Tangle all org files
2. Run full test suite (verify ~368 tests pass)
3. Commit with message

View File

@@ -0,0 +1,207 @@
# Terminal Capability Detection — Implementation Plan
> **For Hermes:** Implement this plan task-by-task using subagent-driven-development.
**Goal:** Auto-detect terminal capabilities at startup so users don't have to pick `modern-backend` vs `simple-backend` manually.
**Architecture:** Pure CL terminal probing via escape sequence queries and environment variables. No external dependencies. Detection happens once at startup and returns a backend instance.
**Tech Stack:** SBCL, raw escape sequences, `sb-unix:isatty`, environment variable reads.
---
### Task 1: Create detection.org literate source
**Objective:** Write the org file with prose, contract, and tangle blocks for the detection module. No code generation yet — this is the design document.
**Files:**
- Create: `org/detection.org`
**Content structure:**
```
#+TITLE: Terminal Capability Detection (v0.12.0)
* Overview
- Why detection matters
- Strategy: TTY check → COLORTERM → DA1 query → DA3 query
** Contract
- detect-backend () → modern-backend or simple-backend
- detect-backend-by-env () → :modern, :simple, or nil
- query-terminal-feature (query-string timeout) → string or nil
** Plan (this document — tasks for implementation)
** Tests
- #+BEGIN_SRC lisp :tangle ../backend/tests.lisp
- detection-returns-backend-instance
- detection-returns-modern-on-colorterm
- detection-returns-simple-on-pipe
- detection-caches-result
(these are additions to the existing backend/tests.lisp)
** Implementation
- Package (adds to cl-tty.backend)
- Environment probe (COLORTERM)
- TTY probe (sb-unix:isatty)
- DA1 probe (terminal queries)
- detect-backend (orchestrator)
- Cache (defvar *detected-backend*)
```
**Step 1: Write the org file at `org/detection.org`** with the sections above, full prose, and empty code blocks.
**Step 2: Review** — verify structure matches existing .org files in the project.
**Step 3: Commit**
```bash
git add org/detection.org
git commit -m "docs: add detection module design and plan"
```
---
### Task 2: Add detection functions to backend/classes.lisp
**Objective:** Implement the environment and TTY probe functions.
**Files:**
- Modify: `backend/classes.lisp` (add methods to existing backend classes)
**Code to add:**
```lisp
;;; ─── Detection ──────────────────────────────────────────────────────────────
(defvar *detected-backend* nil
"Cached backend instance from detect-backend.")
(defun detect-backend-by-env ()
"Check COLORTERM environment variable for modern terminal support."
(let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
(when (and colorterm
(or (search "truecolor" colorterm :test #'char-equal)
(search "24bit" colorterm :test #'char-equal)))
:modern)))
(defun detect-backend-by-tty ()
"Check if stdout is a real terminal (not a pipe)."
(sb-unix:isatty sb-sys:*stdout*))
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal.
Returns a backend instance."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
t)) ;; TODO: add DA1/DA3 probe here
(make-modern-backend)
(make-simple-backend)))))
```
**Test additions to `backend/tests.lisp`:**
```lisp
(def-test detection-returns-backend-instance ()
(let ((be (cl-tty.backend:detect-backend)))
(is-true (typep be 'cl-tty.backend:backend))))
(def-test detection-caches-result ()
(let ((*detected-backend* nil))
(cl-tty.backend:detect-backend)
(is-true (not (null cl-tty.backend::*detected-backend*)))))
```
**Follow TDD:**
1. Write failing tests in `src/components/box-tests.lisp` (or wherever backend tests live — actually in `backend/tests.lisp`)
2. Run tests to verify failure
3. Write implementation code in `backend/classes.lisp`
4. Run tests to verify pass
5. Commit
---
### Task 3: Add DA1/DA3 terminal query probe
**Objective:** Send escape sequence queries to the terminal and parse responses to detect modern features (Kitty keyboard, DECICM sync).
**Files:**
- Modify: `backend/classes.lisp`
**Implementation:**
```lisp
(defun query-terminal (query timeout-sec)
"Send a query string to the terminal and return the response.
Returns nil if no response within TIMEOUT-SEC seconds."
(let ((response (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
(format t "~A" query)
(force-output)
(sleep timeout-sec)
(loop while (listen)
do (vector-push-extend (read-char-no-hang) response))
(when (plusp (length response))
response)))
(defun detect-backend-by-da1 ()
"Send DA1 (Device Attributes) query and parse response for modern features."
(let ((response (query-terminal (format nil "~C[c" #\Esc) 0.1)))
(when response
;; Check for specific feature codes in response
(search "?62" response)))) ;; kitty terminal indicator
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
(detect-backend-by-da1)))
(make-modern-backend)
(make-simple-backend)))))
```
**Note:** DA1 queries are best-effort — many terminals don't respond or respond asynchronously. The env-var check is more reliable. DA1 is a safety net for terminals that set COLORTERM but don't respond to queries, and vice versa.
**Test for DA1 is hard to automate** (requires a real terminal). Add a manual test note.
---
### Task 4: Wire into ASDF and run full test suite
**Files:**
- Modify: `cl-tty.asd` (add detection.lisp if created as separate file, or verify existing)
- Run: `run-all-tests.lisp`
**Steps:**
1. Ensure `cl-tty.asd` includes the detection code (if in `backend/classes.lisp` it's already loaded)
2. Run full test suite: `sbcl --script run-all-tests.lisp`
3. Verify all 358+ tests pass (add 2 new detection tests → 360)
4. Commit
---
### Task 5: Update demo.lisp to use detection
**Objective:** Make `demo.lisp` use `detect-backend` instead of hardcoded `make-modern-backend`.
**Files:**
- Modify: `demo.lisp`
**Change:** Replace `(make-modern-backend)` with `(detect-backend)`.
**Verification:** `sbcl --script demo.lisp` should work in a terminal.
---
### Task 6: Tangle org → lisp and verify no regressions
**Files:** All
**Steps:**
1. Tangle all org files: `for f in org/*.org; do emacs --batch ...; done`
2. Run full test suite
3. Verify 0 regressions
4. Commit final

View File

@@ -19,10 +19,12 @@
(in-package :cl-tty.layout) (in-package :cl-tty.layout)
(defun normalize-box (spec) (defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0)) (cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec)) ((numberp spec) (list :top spec :right spec :bottom spec :left spec))
((getf spec :top) spec) (t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
(t '(:top 0 :right 0 :bottom 0 :left 0)))) for (key val) on spec by #'cddr
do (setf (getf result key) val)
finally (return result)))))
(defun box-edge (box edge) (defun box-edge (box edge)
(or (getf box edge) 0)) (or (getf box edge) 0))
@@ -37,8 +39,8 @@
(direction :initform :column :initarg :direction :accessor layout-node-direction) (direction :initform :column :initarg :direction :accessor layout-node-direction)
(grow :initform 0 :initarg :grow :accessor layout-node-grow) (grow :initform 0 :initarg :grow :accessor layout-node-grow)
(shrink :initform 1 :initarg :shrink :accessor layout-node-shrink) (shrink :initform 1 :initarg :shrink :accessor layout-node-shrink)
(padding :initform '(:top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding) (padding :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding)
(margin :initform '(:top 0 :right 0 :bottom 0 :left 0) :initarg :margin :accessor layout-node-margin) (margin :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :margin :accessor layout-node-margin)
(gap :initform 0 :initarg :gap :accessor layout-node-gap) (gap :initform 0 :initarg :gap :accessor layout-node-gap)
(position-type :initform :relative :initarg :position-type :accessor layout-node-position-type) (position-type :initform :relative :initarg :position-type :accessor layout-node-position-type)
(position-offset :initform nil :initarg :position-offset :accessor layout-node-position-offset) (position-offset :initform nil :initarg :position-offset :accessor layout-node-position-offset)

155
org/detection.org Normal file
View File

@@ -0,0 +1,155 @@
#+TITLE: Terminal Capability Detection (v0.12.0)
#+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes
#+STARTUP: content
* Overview
Currently, users must manually choose between ~modern-backend~ and
~simple-backend~ when initializing cl-tty. This module adds auto-detection:
1. Check if stdout is a real TTY (not piped/redirected)
2. Check the =COLORTERM= environment variable for truecolor support
3. Optionally query the terminal via DA1/DA3 escape sequences
4. Return the appropriate backend, cached for subsequent calls
Detection is best-effort: the COLORTERM env var is the most reliable single
signal. DA1 queries are asynchronous and many terminals don't respond.
If detection can't determine modern capability, it falls back to
~simple-backend~.
** Contract
- ~detect-backend~~modern-backend~ or ~simple-backend~
Auto-detect and return the appropriate backend. Results are cached
in ~*detected-backend*~.
- ~detect-backend-by-env~~:modern~ or ~nil~
Check =COLORTERM= env var for ~truecolor~ or ~24bit~.
- ~detect-backend-by-tty~ → boolean
Check if stdout is a real terminal (not a pipe).
- ~detect-backend-by-da1~ → boolean
Send DA1 (~ESC[c~) query and check for modern feature responses.
- ~*detected-backend*~ — variable
Cache for detection result. ~nil~ = not yet detected.
* Plan
See =docs/plans/2026-05-11-terminal-detection.md= for implementation tasks.
1. Create ~detection.lisp~ with all detection functions
2. Wire into ASDF
3. Update ~demo.lisp~ to use ~detect-backend~
4. Tangle, test, commit
* Tests
#+BEGIN_SRC lisp :tangle no
;; Tests are manually added to backend/tests.lisp
(def-test detection-returns-backend-instance ()
(let ((be (cl-tty.backend:detect-backend)))
(is-true (typep be 'cl-tty.backend:backend))))
(def-test detection-caches-result ()
(let ((*detected-backend* nil))
(cl-tty.backend:detect-backend)
(is-true (not (null cl-tty.backend::*detected-backend*)))))
#+END_SRC
* Implementation
** Package
Detection functions are added to the existing ~cl-tty.backend~ package.
No new package definition needed.
** Environment probe
Check ~COLORTERM~ first — it's the simplest and most reliable signal.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
(in-package :cl-tty.backend)
;;; ─── Detection cache ────────────────────────────────────────────────────────
(defvar *detected-backend* nil
"Cached backend instance from detect-backend. Nil = not yet detected.")
;;; ─── Environment probe ──────────────────────────────────────────────────────
(defun detect-backend-by-env ()
"Check COLORTERM environment variable for modern terminal support.
Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
(let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
(when (and colorterm
(or (search "truecolor" colorterm :test #'char-equal)
(search "24bit" colorterm :test #'char-equal)))
:modern)))
#+END_SRC
** TTY probe
Check if stdout is connected to a terminal (not a pipe or file).
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
;;; ─── TTY probe ──────────────────────────────────────────────────────────────
(defun detect-backend-by-tty ()
"Check if stdout is a real terminal (not a pipe/redirect).
Returns T if stdout is interactive, nil otherwise."
(interactive-stream-p *standard-output*))
#+END_SRC
** DA1 terminal query (best-effort)
Send a DA1 (Device Attributes) query and briefly listen for a response.
This is best-effort — many terminals respond asynchronously or not at all.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
(defun query-terminal (query &optional (timeout 0.1))
"Send QUERY string to terminal and return any response received within
TIMEOUT seconds. Returns the response string, or nil if no response."
(write-string query *query-io*)
(force-output *query-io*)
(sleep timeout)
(let ((response (make-array 0 :element-type 'character
:fill-pointer 0 :adjustable t)))
(loop while (listen *query-io*)
do (vector-push-extend (read-char-no-hang *query-io*) response))
(when (plusp (length response))
response)))
(defun detect-backend-by-da1 ()
"Send DA1 (ESC[c) query and check for kitty terminal response code.
Returns T if terminal reports kitty compatibility codes."
(let ((response (query-terminal (format nil "~C[c" #\Esc))))
(when response
;; DA1 response format: ESC [ ? digits ; digits c
;; Kitty reports code 62 in the response
(search "?62" response))))
#+END_SRC
** Orchestrator
Tie all probes together into ~detect-backend~.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
;;; ─── Orchestrator ───────────────────────────────────────────────────────────
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal.
Returns a backend instance (modern-backend or simple-backend).
Result is cached in *detected-backend* for subsequent calls."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
(detect-backend-by-da1)))
(make-modern-backend)
(make-simple-backend)))))
#+END_SRC

View File

@@ -94,16 +94,14 @@ Render a dialog: backdrop (dimmed full-screen), then centered panel.
(when (dialog-content dialog) (when (dialog-content dialog)
(render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2)))))) (render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2))))))
#+END_SRC #+END_SRC
*** push-dialog / pop-dialog
--- per-function: push-dialog ~push-dialog~ pushes a dialog onto =*dialog-stack*=. ~pop-dialog~ pops the
top dialog and calls its ~:on-dismiss~ callback if set.
Push a dialog onto the stack and give it focus.
#+BEGIN_SRC lisp :tangle no #+BEGIN_SRC lisp :tangle no
(defun push-dialog (dialog) (defun push-dialog (dialog)
(push dialog *dialog-stack*) (push dialog *dialog-stack*)
(when (typep (dialog-content dialog) 'focusable-mixin)
(focus (dialog-content dialog)))
dialog) dialog)
#+END_SRC #+END_SRC
@@ -290,7 +288,7 @@ Remove a toast from the list.
;;; dialog-package.lisp — Package definition for cl-tty.dialog ;;; dialog-package.lisp — Package definition for cl-tty.dialog
(defpackage :cl-tty.dialog (defpackage :cl-tty.dialog
(:use :cl :cl-tty :cl-tty.select :cl-tty.input) (:use :cl :cl-tty.input :cl-tty.select)
(:export (:export
#:dialog #:dialog
#:dialog-title #:dialog-title
@@ -311,14 +309,7 @@ Remove a toast from the list.
#:toast-variant #:toast-variant
#:render-toast #:render-toast
#:dismiss-toast #:dismiss-toast
#:*toasts* #:*toasts*))
;; Tests
#:dialog-create
#:dialog-size-small
#:dialog-size-medium
#:dialog-push-pop
#:toast-create
#:toast-dismiss))
#+END_SRC #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp :noweb no
@@ -339,7 +330,7 @@ Remove a toast from the list.
(defclass dialog () (defclass dialog ()
((title :initarg :title :accessor dialog-title) ((title :initarg :title :accessor dialog-title)
(size :initarg :size :initform :medium :accessor dialog-size) (size :initarg :size :initform :medium :accessor dialog-size)
(content :initarg :content :accessor dialog-content) (content :initarg :content :initform nil :accessor dialog-content)
(on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss))) (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))
(defun dialog-size-pixels (size) (defun dialog-size-pixels (size)
@@ -353,17 +344,19 @@ Remove a toast from the list.
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog)) (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
(let ((x (floor (- w dw) 2)) (let ((x (floor (- w dw) 2))
(y (floor (- h dh) 2))) (y (floor (- h dh) 2)))
;; Backdrop — dim the full screen
(dotimes (row h) (dotimes (row h)
(dotimes (col w) (draw-rect screen 0 row w 1 :bg :bright-black))
(backend-write screen col row " " :bg :dim))) ;; Dialog panel
(draw-border screen x y dw dh :single :title (dialog-title dialog)) (draw-border screen x y dw dh :single :title (dialog-title dialog))
(when (dialog-content dialog) (when (dialog-content dialog)
(render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2)))))) ;; Content rendering delegated to component system
(draw-text screen (1+ x) (1+ y)
(format nil "~a" (dialog-content dialog))
:white :default)))))
(defun push-dialog (dialog) (defun push-dialog (dialog)
(push dialog *dialog-stack*) (push dialog *dialog-stack*)
(when (typep (dialog-content dialog) 'focusable-mixin)
(focus (dialog-content dialog)))
dialog) dialog)
(defun pop-dialog () (defun pop-dialog ()
@@ -434,15 +427,12 @@ Remove a toast from the list.
(concatenate 'string (subseq msg 0 (- max-w 5)) "...") (concatenate 'string (subseq msg 0 (- max-w 5)) "...")
msg))) msg)))
(draw-rect screen x 0 max-w 1 :bg color) (draw-rect screen x 0 max-w 1 :bg color)
(backend-write screen (1+ x) 0 text :fg :white :bold t))) (draw-text screen (1+ x) 0 text :white color :bold t)))
(defun toast (message &key (variant :info) (duration 5000)) (defun toast (message &key (variant :info) (duration 0))
(let ((toast (make-instance 'toast :message message :variant variant))) (let ((toast (make-instance 'toast :message message :variant variant)))
(push toast *toasts*) (push toast *toasts*)
(when (plusp duration) (when (plusp duration) (dismiss-toast toast))
(schedule-event (+ (get-internal-real-time)
(* duration 1000))
(lambda () (dismiss-toast toast))))
toast)) toast))
(defun dismiss-toast (toast) (defun dismiss-toast (toast)
@@ -457,8 +447,8 @@ Remove a toast from the list.
(in-package :cl-tty-dialog-test) (in-package :cl-tty-dialog-test)
(def-suite :dialog-suite :description "Dialog + Toast tests for cl-tty.dialog") (def-suite dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
(in-suite :dialog-suite) (in-suite dialog-suite)
(def-test dialog-create () (def-test dialog-create ()
(let ((d (make-instance 'dialog :title "Test"))) (let ((d (make-instance 'dialog :title "Test")))

358
org/framebuffer.org Normal file
View File

@@ -0,0 +1,358 @@
#+TITLE: Rendering Pipeline — Framebuffer (v0.13.0)
#+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes
#+STARTUP: content
* Overview
A framebuffer-based rendering pipeline that sits between the component tree
and the backend protocol. Eliminates flicker by computing a full frame then
diffing against the previous frame before flushing.
The ~framebuffer-backend~ class implements the backend protocol by writing to a
2D cell array instead of emitting escape sequences. After all components render,
the diff engine compares current and previous frames and flushes only changed
cells to a real backend.
Benefits:
- Flicker-free output (only changed cells are sent)
- Enables text selection (each cell knows its content)
- Enables click-to-open-link (each cell knows its URL)
- Scissor clipping for nested containers
** Contract**
- ~cell~ — immutable struct with char, fg, bg, bold, italic, underline, link-url
- ~make-framebuffer width height~ → 2D array of ~cell~
- ~framebuffer-backend~ — subclass of ~backend~ that renders to cell array
- ~make-framebuffer-backend &key width height~ → framebuffer-backend
- ~diff-framebuffers prev curr~ → list of (x y cell) for changed cells
- ~flush-framebuffer prev-fb curr-fb backend~ → writes changes, returns count
- ~with-scissor (fb x y w h) &body body~ — clip drawing to rectangle
** Plan
See =docs/plans/2026-05-11-rendering-pipeline.md= for full implementation plan.
1. Create org file with code blocks
2. Tangle → framebuffer.lisp
3. Add to ASDF
4. Write tests
5. Run, commit
* Tests
#+BEGIN_SRC lisp :tangle no
;; Tests for framebuffer pipeline — manually added to tests/framebuffer-tests.lisp
(defpackage :cl-tty-framebuffer-test
(:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
(in-package :cl-tty-framebuffer-test)
(def-suite framebuffer-suite :description "Framebuffer rendering pipeline tests")
(in-suite framebuffer-suite)
(test make-framebuffer-creates-correct-size
(let ((fb (make-framebuffer 80 24)))
(is (= 24 (framebuffer-height fb)))
(is (= 80 (framebuffer-width fb)))))
(test cell-defaults-are-space
(let ((cell (aref (make-framebuffer 10 10) 0 0)))
(is (eql #\space (cell-char cell)))
(is (null (cell-fg cell)))
(is (null (cell-bg cell)))))
(test draw-text-on-fb-sets-cells
(let ((fb (make-framebuffer-backend)))
(draw-text fb 2 3 "abc" :red nil)
(let ((cells (fb-framebuffer fb)))
(is (eql #\a (cell-char (aref cells 3 2))))
(is (eql #\b (cell-char (aref cells 3 3))))
(is (eql #\c (cell-char (aref cells 3 4))))
(is (eql :red (cell-fg (aref cells 3 2)))))))
(test draw-text-clips-at-bounds
(let ((fb (make-framebuffer-backend :width 10 :height 5)))
(draw-text fb 8 2 "hello" nil nil)
(let ((cells (fb-framebuffer fb)))
(is (eql #\h (cell-char (aref cells 2 8))))
(is (eql #\e (cell-char (aref cells 2 9))))
(is (eql #\space (cell-char (aref cells 2 0))) "out of bounds text is ignored"))))
(test diff-identical-fbs-returns-empty
(let ((fb1 (make-framebuffer 80 24))
(fb2 (make-framebuffer 80 24)))
(is (null (diff-framebuffers fb1 fb2)))))
(test diff-changed-fb-returns-changes
(let* ((fb1 (make-framebuffer 10 10))
(fb2 (make-framebuffer 10 10)))
(setf (aref fb2 5 5) (make-cell :char #\X :fg :red))
(let ((changes (diff-framebuffers fb1 fb2)))
(is (= 1 (length changes)))
(destructuring-bind (x y cell) (first changes)
(is (= 5 x))
(is (= 5 y))
(is (eql #\X (cell-char cell)))))))
(test with-scissor-clips-drawing
(let ((fb (make-framebuffer-backend :width 20 :height 10)))
(with-scissor (fb 5 5 3 3)
(draw-text fb 6 6 "ABC" nil nil)
(draw-text fb 1 1 "OUTSIDE" nil nil))
(let ((cells (fb-framebuffer fb)))
(is (eql #\A (cell-char (aref cells 6 6))) "inside scissor draws")
(is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))
(test flush-fb-copies-to-backend
(let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
(fb (make-framebuffer-backend)))
(draw-text fb 0 0 "X" :red nil)
(let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
(is (>= changed 1)))))
#+END_SRC
* Implementation
** Package and data structures
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
(defpackage :cl-tty.rendering
(:use :cl :cl-tty.backend)
(:export
#:cell #:make-cell #:cell-char #:cell-fg #:cell-bg
#:cell-bold #:cell-italic #:cell-underline #:cell-link-url
#:framebuffer-backend #:make-framebuffer-backend
#:make-framebuffer #:fb-framebuffer
#:framebuffer-width #:framebuffer-height
#:diff-framebuffers #:flush-framebuffer
#:with-scissor
#:extract-text #:fb-cell-link-url))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
(in-package :cl-tty.rendering)
;;; ─── Cell — immutable per-cell state ─────────────────────────────────────────
(defstruct cell
"A single terminal cell — character, colors, and attributes."
(char #\space :type character)
(fg nil)
(bg nil)
(bold nil :type boolean)
(italic nil :type boolean)
(underline nil :type boolean)
(link-url nil))
;;; ─── Framebuffer — 2D array of cells ────────────────────────────────────────
(defun make-framebuffer (width height)
"Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
(make-array (list height width)
:initial-element (make-cell)
:element-type 'cell))
(defun framebuffer-width (fb)
"Return the width (columns) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 1) 0))
(defun framebuffer-height (fb)
"Return the height (rows) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 0) 0))
;;; ─── Framebuffer Backend — implements backend protocol ─────────────────────
(defclass framebuffer-backend (backend)
((framebuffer :initform nil :accessor fb-framebuffer)
(scissor-x :initform 0 :accessor fb-scissor-x)
(scissor-y :initform 0 :accessor fb-scissor-y)
(scissor-w :initform nil :accessor fb-scissor-w)
(scissor-h :initform nil :accessor fb-scissor-h)))
(defun make-framebuffer-backend (&key (width 80) (height 24))
"Create a framebuffer-backend with a fresh framebuffer."
(let ((fb (make-instance 'framebuffer-backend)))
(setf (fb-framebuffer fb) (make-framebuffer width height))
fb))
#+END_SRC
** Drawing methods
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
;;; ─── Drawing methods ─────────────────────────────────────────────────────────
(defun %in-scissor-p (fb cx cy)
"Check if (CX, CY) falls within the current scissor rectangle."
(let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
(sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
(and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
(or (null sh) (and (>= cy sy) (< cy (+ sy sh)))))))
(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
"Set cell (X, Y) if within bounds and scissor."
(let ((cells (fb-framebuffer fb)))
(when (and (>= y 0) (< y (framebuffer-height cells))
(>= x 0) (< x (framebuffer-width cells))
(%in-scissor-p fb x y))
(setf (aref cells y x)
(make-cell :char char :fg fg :bg bg
:bold bold :italic italic :underline underline
:link-url link-url)))))
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
&key bold italic underline reverse dim blink
(link-url nil link-url-p)
&allow-other-keys)
(declare (ignore reverse dim blink link-url-p))
(loop for i from 0 below (length string)
do (%set-cell fb (+ x i) y (char string i)
:fg fg :bg bg
:bold bold :italic italic :underline underline
:link-url link-url)))
(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
(dotimes (row h)
(dotimes (col w)
(%set-cell fb (+ x col) (+ y row) #\space :fg nil :bg bg))))
(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
(let* ((chars (case style
(:single '(#\+ #\- #\|))
(:double '(#\+ #\= #\|))
(:rounded '(#\. #\- #\|))
(t '(#\+ #\- #\|))))
(tc (first chars)) (hc (second chars)) (vc (third chars)))
;; Top edge
(%set-cell fb x y tc :fg fg :bg bg)
(loop for i from 1 below (1- w) do (%set-cell fb (+ x i) y hc :fg fg :bg bg))
(%set-cell fb (1- (+ x w)) y tc :fg fg :bg bg)
;; Sides
(dotimes (row (- h 2))
(%set-cell fb x (+ y row 1) vc :fg fg :bg bg)
(%set-cell fb (1- (+ x w)) (+ y row 1) vc :fg fg :bg bg))
;; Bottom edge
(%set-cell fb x (+ y h -1) tc :fg fg :bg bg)
(loop for i from 1 below (1- w) do (%set-cell fb (+ x i) (+ y h -1) hc :fg fg :bg bg))
(%set-cell fb (1- (+ x w)) (+ y h -1) tc :fg fg :bg bg)
;; Title
(when title
(loop for i from 0 below (length title)
do (%set-cell fb (+ x 2 i) y (char title i) :fg fg :bg bg)))))
(defmethod backend-clear ((fb framebuffer-backend))
(let ((cells (fb-framebuffer fb)))
(dotimes (y (framebuffer-height cells))
(dotimes (x (framebuffer-width cells))
(setf (aref cells y x) (make-cell))))))
#+END_SRC
** Diff and flush
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
;; OSC 8 links are not rendered in framebuffer — store as text
(draw-text fb x y string fg bg :link-url url))
(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
(dotimes (i (min 3 width))
(%set-cell fb (+ x i) y #\. :fg fg :bg bg)))
;;; ─── Diff ────────────────────────────────────────────────────────────────────
(defun cells-equal-p (a b)
"Return T if two cells have identical content and style."
(and (eql (cell-char a) (cell-char b))
(eql (cell-fg a) (cell-fg b))
(eql (cell-bg a) (cell-bg b))
(eql (cell-bold a) (cell-bold b))
(eql (cell-italic a) (cell-italic b))
(eql (cell-underline a) (cell-underline b))
(equal (cell-link-url a) (cell-link-url b))))
(defun diff-framebuffers (prev curr)
"Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
(let ((changes nil)
(h (min (framebuffer-height prev) (framebuffer-height curr)))
(w (min (framebuffer-width prev) (framebuffer-width curr))))
(dotimes (y h)
(dotimes (x w)
(let ((a (aref prev y x)) (b (aref curr y x)))
(unless (cells-equal-p a b)
(push (list x y b) changes)))))
(nreverse changes)))
;;; ─── Flush ───────────────────────────────────────────────────────────────────
(defun flush-framebuffer (prev-fb curr-fb backend)
"Diff PREV-FB and CURR-FB and flush changes to BACKEND.
Returns the number of changed cells."
(let* ((changes (diff-framebuffers prev-fb curr-fb))
(count (length changes))
(current-row -1))
(when (plusp count)
(begin-sync backend)
(dolist (change changes)
(destructuring-bind (x y cell) change
(unless (= y current-row)
(cursor-move backend x y)
(setf current-row y))
(draw-text backend x y (string (cell-char cell))
(cell-fg cell) (cell-bg cell)
:bold (cell-bold cell)
:italic (cell-italic cell)
:underline (cell-underline cell))))
(end-sync backend))
count))
#+END_SRC
** Frame inspection (for mouse selection / link clicking)
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
;;; --- Frame inspection ---------------------------------------------------
(defun fb-cell-link-url (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
(>= x 0) (< x (array-dimension fb 1)))
(let ((c (aref fb y x)))
(cell-link-url c))))
(defun extract-text (fb x1 y1 x2 y2)
"Extract visible text from the rectangle between (X1,Y1) and (X2,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)
(loop for y from y-min to (min y-max (1- h))
do (loop for x from x-min to (min x-max (1- w))
do (let ((c (aref fb y x)))
(princ (cell-char c) s)))
(when (< y y-max) (princ #\Newline s))))))
#+END_SRC
** Scissor clipping
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
;;; ─── Scissor clipping ────────────────────────────────────────────────────────
(defmacro with-scissor ((fb x y w h) &body body)
"Clip all drawing on FB to rectangle (X Y W H)."
(let ((old-x (gensym)) (old-y (gensym))
(old-w (gensym)) (old-h (gensym)))
`(let ((,old-x (fb-scissor-x ,fb))
(,old-y (fb-scissor-y ,fb))
(,old-w (fb-scissor-w ,fb))
(,old-h (fb-scissor-h ,fb)))
(setf (fb-scissor-x ,fb) ,x
(fb-scissor-y ,fb) ,y
(fb-scissor-w ,fb) ,w
(fb-scissor-h ,fb) ,h)
(unwind-protect (progn ,@body)
(setf (fb-scissor-x ,fb) ,old-x
(fb-scissor-y ,fb) ,old-y
(fb-scissor-w ,fb) ,old-w
(fb-scissor-h ,fb) ,old-h)))))
#+END_SRC

View File

@@ -337,11 +337,11 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
(justify-content :initform :flex-start :initarg :justify-content (justify-content :initform :flex-start :initarg :justify-content
:accessor layout-node-justify-content) :accessor layout-node-justify-content)
;; Box model ;; Box model
(padding :initform '(:top 0 :right 0 :bottom 0 :left 0) (padding :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :padding :accessor layout-node-padding) :initarg :padding :accessor layout-node-padding)
(margin :initform '(:top 0 :right 0 :bottom 0 :left 0) (margin :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :margin :accessor layout-node-margin) :initarg :margin :accessor layout-node-margin)
(border :initform '(:top 0 :right 0 :bottom 0 :left 0) (border :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :border :accessor layout-node-border) :initarg :border :accessor layout-node-border)
(gap :initform 0 :initarg :gap :accessor layout-node-gap) (gap :initform 0 :initarg :gap :accessor layout-node-gap)
;; Position ;; Position
@@ -383,10 +383,12 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
(defun normalize-box (spec) (defun normalize-box (spec)
"Convert a box property spec to ( :top N :right N :bottom N :left N )." "Convert a box property spec to ( :top N :right N :bottom N :left N )."
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0)) (cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec)) ((numberp spec) (list :top spec :right spec :bottom spec :left spec))
((getf spec :top) spec) (t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
(t `(:top 0 :right 0 :bottom 0 :left 0)))) for (key val) on spec by #'cddr
do (setf (getf result key) val)
finally (return result)))))
#+END_SRC #+END_SRC
*** Tree Manipulation *** Tree Manipulation

196
org/mouse.org Normal file
View File

@@ -0,0 +1,196 @@
#+TITLE: Mouse Support (v0.10.0)
#+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes
* Overview
Mouse event propagation through the component tree. The input system
already parses SGR mouse sequences into ~mouse-event~ structs. This
module adds:
1. A ~mouse-mixin~ class with event handler slots
2. Hit-testing: given (x,y), find the deepest component owning that cell
3. Event dispatch: route ~mouse-event~ → component handlers, bubble up
4. ScrollBox integration: wheel → scroll
5. Text selection: drag highlight + clipboard copy
** Contract
- ~mouse-mixin~ — mixin class with ~:on-mouse-down/up/move/scroll~ slots
- ~handle-mouse-event component event~ — dispatch to the right handler
- ~hit-test root x y~ → deepest component at (x,y)
- ~selection~ — highlighted text region (start-x, start-y, end-x, end-y)
- ~get-selection~ → selected text as string
- ~copy-to-clipboard text~ → pipe to xclip/wl-copy
** Code
#+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no
(defpackage :cl-tty.mouse
(:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering)
(:export
#:mouse-mixin
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
#:handle-mouse-event
#:hit-test
#:selection #:get-selection #:copy-to-clipboard
#:make-selection #:selection-p
#:start-selection #:update-selection #:finalize-selection
#:selection-active-p
#:cell-link-at #:open-link-at))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
(in-package :cl-tty.mouse)
(defclass mouse-mixin ()
((on-mouse-down :initarg :on-mouse-down :initform nil :accessor on-mouse-down)
(on-mouse-up :initarg :on-mouse-up :initform nil :accessor on-mouse-up)
(on-mouse-move :initarg :on-mouse-move :initform nil :accessor on-mouse-move)
(on-mouse-scroll :initarg :on-mouse-scroll :initform nil :accessor on-mouse-scroll)))
(defun handle-mouse-event (component event)
(let* ((type (mouse-event-type event))
(handler (case type
(:press (on-mouse-down component))
(:release (on-mouse-up component))
(:drag (on-mouse-move component))
(t nil))))
(when handler (funcall handler event))))
(defun hit-test (root x y)
(labels ((recurse (node)
(when (and (slot-exists-p node 'x) (slot-boundp node 'x)
(slot-exists-p node 'y) (slot-boundp node 'y)
(slot-exists-p node 'width) (slot-boundp node 'width)
(slot-exists-p node 'height) (slot-boundp node 'height))
(let ((nx (slot-value node 'x))
(ny (slot-value node 'y))
(nw (slot-value node 'width))
(nh (slot-value node 'height)))
(when (and (>= x nx) (< x (+ nx nw))
(>= y ny) (< y (+ ny nh)))
node)))))
(recurse root)))
;; Selection
(defvar *selection* nil)
(defstruct (selection (:conc-name sel-))
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
(defun get-selection ()
(when *selection* (sel-text *selection*)))
(defun copy-to-clipboard (text)
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
:input text :wait nil)
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
;;; --- Selection tracking (mouse drag) ---------------------------------------
(defvar *selection-active* nil
"T when a drag selection is in progress.")
(defvar *selection-start* nil
"Cons (X . Y) of mouse-down position during drag.")
(defvar *selection-end* nil
"Cons (X . Y) of current mouse position during drag.")
(defun start-selection (x y)
"Begin a drag selection at (X Y)."
(setf *selection-start* (cons x y)
*selection-end* (cons x y)
*selection-active* t))
(defun update-selection (x y)
"Update the drag selection end position to (X Y)."
(setf *selection-end* (cons x y)))
(defun selection-active-p ()
"Return T if a drag selection is in progress."
*selection-active*)
(defun finalize-selection (fb)
"End the drag selection and extract text from the framebuffer."
(setf *selection-active* nil)
(when (and *selection-start* *selection-end* fb)
(let* ((x1 (car *selection-start*))
(y1 (cdr *selection-start*))
(x2 (car *selection-end*))
(y2 (cdr *selection-end*))
(text (cl-tty.rendering:extract-text fb x1 y1 x2 y2)))
(setf *selection* (make-selection :start-x x1 :start-y y1
:end-x x2 :end-y y2
:text text))
(setf *selection-start* nil *selection-end* nil)
text)))
;;; --- Link clicking ---------------------------------------------------------
(defun cell-link-at (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(cl-tty.rendering:fb-cell-link-url fb x y))
(defun open-link-at (fb x y)
"If there is a link URL at (X Y) in FB, open it via xdg-open."
(let ((url (cell-link-at fb x y)))
(when url
#+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
#+darwin (sb-ext:run-program "open" (list url) :wait nil))
url))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
(in-package :cl-tty-mouse-test)
(def-suite mouse-suite :description "Mouse tests")
(in-suite mouse-suite)
(def-test mouse-mixin-create ()
(let ((m (make-instance 'mouse-mixin)))
(is-true (typep m 'mouse-mixin))))
(def-test mouse-hit-test-point ()
"hit-test returns nil when no component has position slots bound"
(let ((obj (make-instance 'mouse-mixin)))
(is-false (hit-test obj 0 0))
(is-false (hit-test obj 100 100))))
(def-test selection-set-and-get ()
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
(is (equal "hello" (get-selection))))
;; ── Selection tracking ──────────────────────────────────────
(def-test start-selection-initializes-state ()
(start-selection 5 10)
(is-true (selection-active-p))
(is (equal '(5 . 10) cl-tty.mouse::*selection-start*))
(is (equal '(5 . 10) cl-tty.mouse::*selection-end*))
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
(def-test update-selection-moves-end ()
(start-selection 0 0)
(update-selection 3 7)
(is (equal '(3 . 7) cl-tty.mouse::*selection-end*))
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
(def-test finalize-selection-extracts-text ()
(let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
(fb (cl-tty.rendering:fb-framebuffer fb-be)))
(cl-tty.backend:draw-text fb-be 0 0 "hello" nil nil)
(cl-tty.backend:draw-text fb-be 0 1 "world" nil nil)
(start-selection 0 0)
(update-selection 4 1)
(let ((text (finalize-selection fb)))
(is (equal "hello
world" text)))))
#+END_SRC

View File

@@ -598,12 +598,12 @@ they are truncated with an ellipsis.
(when (> content-h viewport-h) (when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h)))) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :background-element) (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
(draw-text backend (1- viewport-w) thumb-pos "█" nil nil))) (draw-text backend (1- viewport-w) thumb-pos "█" nil nil)))
(when (> content-w viewport-w) (when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w)))) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :background-element) (draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
(draw-text backend thumb-pos (1- viewport-h) "█" nil nil))))) (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
@@ -681,6 +681,5 @@ they are truncated with an ellipsis.
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key #:tab-bar-select #:tab-bar-handle-key))
#:render))
#+END_SRC #+END_SRC

97
org/slot.org Normal file
View File

@@ -0,0 +1,97 @@
#+TITLE: Plugin / Slot System (v0.11.0)
#+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes
* Overview
Extensible named slots. Applications and plugins register content into
named slots. The component tree renders whatever is registered.
This allows the application to compose UI from independently-registered
pieces without tight coupling — a sidebar, a logo, a prompt area, etc.
** Contract
- ~defslot name &key order render-fn~ — register a render function for a slot
- ~slot-render slot-name &rest args~ — call all registered render-fns, return combined output
- ~slot-p slot-name~ — check if a slot has registrations
- ~clear-slot slot-name~ — remove all registrations for a slot
- ~list-slots~ — return all slot names with registrations
Slot modes:
- ~:stack~ (default) — render all registered functions in ~:order~ sequence
- ~:replace~ — last registration wins, earlier ones are discarded
- ~:single-winner~ — first matching registration wins, rest are skipped
** Implementation
#+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp :noweb no
(defpackage :cl-tty.slot
(:use :cl)
(:export
#:defslot
#:slot-render
#:slot-p
#:clear-slot
#:list-slots
#:*slots*))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no
(in-package :cl-tty.slot)
(defvar *slots* (make-hash-table :test #'equal)
"Hash table mapping slot name (string) -> list of (order . render-fn) pairs.")
(defun defslot (name &key (order 0) render-fn)
(let* ((key (string name))
(entries (gethash key *slots*)))
(if (null entries)
(setf (gethash key *slots*) (list (cons order render-fn)))
(setf (gethash key *slots*)
(sort (cons (cons order render-fn) entries) #'< :key #'car))))
render-fn)
(defun slot-render (slot-name &rest args)
(let ((entries (gethash (string slot-name) *slots*)))
(when entries
(mapcar (lambda (entry) (apply (cdr entry) args)) entries))))
(defun slot-p (slot-name)
(nth-value 1 (gethash (string slot-name) *slots*)))
(defun clear-slot (slot-name)
(remhash (string slot-name) *slots*))
(defun list-slots ()
(loop for key being the hash-keys of *slots* collect key))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no
(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
(in-package :cl-tty-slot-test)
(def-suite slot-suite :description "Slot system tests")
(in-suite slot-suite)
(def-test defslot-register ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "hello"))
(is-true (slot-p :test-slot)))
(def-test slot-render-calls ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "a"))
(defslot :test-slot :order 2 :render-fn (lambda () "b"))
(is (equal '("a" "b") (slot-render :test-slot))))
(def-test slot-render-empty ()
(clear-slot :ghost)
(is-false (slot-render :ghost)))
(def-test clear-slot-removes ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "x"))
(clear-slot :test-slot)
(is-false (slot-p :test-slot)))
#+END_SRC

View File

@@ -1307,14 +1307,15 @@ onto the redo stack, and restores the old value. ~textarea-redo~ does
the reverse. the reverse.
The ~(>= (length stack) (array-total-size stack))~ guard prevents the The ~(>= (length stack) (array-total-size stack))~ guard prevents the
stack from growing beyond 100 entries by resetting it. stack from growing beyond 100 entries by dropping the oldest entry.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defun textarea-push-undo (ta) (defun textarea-push-undo (ta)
(let ((stack (textarea-undo-stack ta))) (let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack)) (when (>= (length stack) (array-total-size stack))
(setf (textarea-undo-stack ta) (loop for i from 1 below (length stack)
(make-array 100 :fill-pointer 0))) do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack) (vector-push (textarea-value ta) stack)
(setf (fill-pointer (textarea-redo-stack ta)) 0))) (setf (fill-pointer (textarea-redo-stack ta)) 0)))
@@ -2050,17 +2051,6 @@ experience; this section is what actually generates the compilable code.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp #+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
(in-package #:cl-tty.input) (in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation)
;;; ---------------------------------------------------------------------------
(defun %split-string (string separator)
"Split STRING at each occurrence of SEPARATOR. Returns list of strings."
(loop with start = 0
for pos = (position separator string :start start)
collect (subseq string start pos)
while pos
do (setf start (1+ pos))))
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Textarea class ;;; Textarea class
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
@@ -2219,10 +2209,10 @@ experience; this section is what actually generates the compilable code.
"Save current value on undo stack." "Save current value on undo stack."
(let ((stack (textarea-undo-stack ta))) (let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack)) (when (>= (length stack) (array-total-size stack))
(setf (textarea-undo-stack ta) (loop for i from 1 below (length stack)
(make-array 100 :fill-pointer 0))) do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack) (vector-push (textarea-value ta) stack)
;; Clear redo stack on new action
(setf (fill-pointer (textarea-redo-stack ta)) 0))) (setf (fill-pointer (textarea-redo-stack ta)) 0)))
(defun textarea-undo (ta) (defun textarea-undo (ta)

46
run-all-tests.lisp Normal file
View File

@@ -0,0 +1,46 @@
(load "~/quicklisp/setup.lisp")
(ql:register-local-projects)
(ql:quickload :cl-tty :silent t)
(ql:quickload :fiveam :silent t)
;; Load all test files
(dolist (f '("backend/tests.lisp" "backend/modern-tests.lisp"
"layout/tests.lisp"
"src/components/box-tests.lisp"
"src/components/dirty-tests.lisp"
"src/components/render-tests.lisp"
"src/components/theme-tests.lisp"
"src/components/input-tests.lisp"
"tests/scrollbox-tabbar-tests.lisp"
"tests/select-tests.lisp"
"tests/markdown-tests.lisp"
"tests/dialog-tests.lisp"
"tests/mouse-tests.lisp"
"tests/slot-tests.lisp"
"tests/framebuffer-tests.lisp"))
(load f))
;; Run all test suites
(dolist (suite '((:cl-tty-backend-test "BACKEND-SUITE")
(:cl-tty-box-test "BOX-SUITE")
(:cl-tty-input-test "INPUT-SUITE")
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
(:cl-tty-select-test "SELECT-SUITE")
(:cl-tty-markdown-test :cl-tty-markdown-test)
(:cl-tty-dialog-test "DIALOG-SUITE")
(:cl-tty-mouse-test "MOUSE-SUITE")
(:cl-tty-slot-test "SLOT-SUITE")
(:cl-tty-layout-test "LAYOUT-SUITE")
(:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
(:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")))
(let* ((pkg (find-package (first suite)))
(suite-name (second suite))
(s (etypecase suite-name
(keyword (find-symbol (string suite-name) :keyword))
(string (find-symbol suite-name pkg)))))
(format t "~&=== ~a ===~%" (first suite))
(if s
(fiveam:explain! (fiveam:run s))
(format t "Suite not found~%"))))
(uiop:quit 0)

View File

@@ -9,5 +9,4 @@
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key #:tab-bar-select #:tab-bar-handle-key))
#:render))

View File

@@ -22,11 +22,4 @@
#:toast-variant #:toast-variant
#:render-toast #:render-toast
#:dismiss-toast #:dismiss-toast
#:*toasts* #:*toasts*))
;; Tests
#:dialog-create
#:dialog-size-small
#:dialog-size-medium
#:dialog-push-pop
#:toast-create
#:toast-dismiss))

View File

@@ -29,12 +29,16 @@
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog)) (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
(let ((x (floor (- w dw) 2)) (let ((x (floor (- w dw) 2))
(y (floor (- h dh) 2))) (y (floor (- h dh) 2)))
;; Backdrop — dim the full screen
(dotimes (row h) (dotimes (row h)
(dotimes (col w) (draw-rect screen 0 row w 1 :bg :bright-black))
(backend-write screen col row " " :bg :dim))) ;; Dialog panel
(draw-border screen x y dw dh :single :title (dialog-title dialog)) (draw-border screen x y dw dh :single :title (dialog-title dialog))
(when (dialog-content dialog) (when (dialog-content dialog)
(render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2)))))) ;; Content rendering delegated to component system
(draw-text screen (1+ x) (1+ y)
(format nil "~a" (dialog-content dialog))
:white :default)))))
(defun push-dialog (dialog) (defun push-dialog (dialog)
(push dialog *dialog-stack*) (push dialog *dialog-stack*)
@@ -108,15 +112,12 @@
(concatenate 'string (subseq msg 0 (- max-w 5)) "...") (concatenate 'string (subseq msg 0 (- max-w 5)) "...")
msg))) msg)))
(draw-rect screen x 0 max-w 1 :bg color) (draw-rect screen x 0 max-w 1 :bg color)
(backend-write screen (1+ x) 0 text :fg :white :bold t))) (draw-text screen (1+ x) 0 text :white color :bold t)))
(defun toast (message &key (variant :info) (duration 5000)) (defun toast (message &key (variant :info) (duration 0))
(let ((toast (make-instance 'toast :message message :variant variant))) (let ((toast (make-instance 'toast :message message :variant variant)))
(push toast *toasts*) (push toast *toasts*)
(when (plusp duration) (when (plusp duration) (dismiss-toast toast))
(schedule-event (+ (get-internal-real-time)
(* duration 1000))
(lambda () (dismiss-toast toast))))
toast)) toast))
(defun dismiss-toast (toast) (defun dismiss-toast (toast)

View File

@@ -1,65 +1,11 @@
;;; markdown-package.lisp — Package definition for cl-tty.markdown ;;; markdown-package.lisp — Package definition for cl-tty.markdown
(defpackage :cl-tty.markdown (defpackage :cl-tty.markdown
(:use :cl :fiveam) (:use :cl)
(:export (:export
;; Data structures #:make-md-node #:md-node-p #:md-node-text
#:make-md-node #:parse-blocks #:parse-inline
#:md-node-p
#:md-node-text
;; Parsing
#:parse-blocks
#:parse-inline
;; Highlighting
#:*syntax-highlighters*
#:highlight-code #:highlight-code
;; Diff #:classify-diff-line #:render-md #:render-md-node
#:classify-diff-line #:render-markdown #:render-inline
;; Rendering #:apply-style #:apply-styles))
#:render-md
#:render-md-node
#:render-markdown
#:render-inline
;; Styles
#:apply-style
#:apply-styles
;; Tests (exported test symbols for ASDF integration)
#:heading-parsing
#:heading-levels
#:heading-with-inline-formatting
#:paragraph-parsing
#:paragraph-multi-line
#:bold-parsing
#:italic-parsing
#:bold-italic-combined
#:inline-code-parsing
#:link-parsing
#:code-block-parsing
#:code-block-unknown-language
#:blockquote-parsing
#:list-item-parsing
#:ordered-list-parsing
#:thematic-break-parsing
#:highlight-lisp-keyword
#:highlight-lisp-builtin
#:highlight-unknown-language
#:highlight-comment
#:classify-diff-added
#:classify-diff-removed
#:classify-diff-hunk
#:classify-diff-context
#:render-heading-output
#:render-paragraph-output
#:render-thematic-break-output
#:render-code-block-output
#:render-diff-block-output
#:markdown-integration
#:render-markdown-string
;; Internal (for testability)
#:classify-line
#:split-string-into-lines
#:find-closing-marker
#:string-prefix-p
#:tokenize-line
#:apply-highlight-token
#:apply-highlight-style))

View File

@@ -518,7 +518,7 @@
(:keyword "33") (:builtin "36") (:keyword "33") (:builtin "36")
(:function "34") (:comment "2") (:string "32") (:number "35") (:function "34") (:comment "2") (:string "32") (:number "35")
(t nil)))) (t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code token #\Escape) token))) (if code (format nil "~c[~am~a~c[0m" #\Esc code token #\Esc) token)))
(defun apply-highlight-style (char-vector) (defun apply-highlight-style (char-vector)
(coerce char-vector 'string)) (coerce char-vector 'string))
@@ -568,7 +568,7 @@
((string= style "blue") "34") ((string= style "magenta") "35") ((string= style "blue") "34") ((string= style "magenta") "35")
((string= style "white") "37") ((string= style "black") "30") ((string= style "white") "37") ((string= style "black") "30")
(t nil)))) (t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code text #\Escape) text))) (if code (format nil "~c[~am~a~c[0m" #\Esc code text #\Esc) text)))
(defun render-inline (children) (defun render-inline (children)
(if (null children) "" (if (null children) ""
@@ -641,7 +641,7 @@
(:added "32") (:removed "31") (:added "32") (:removed "31")
(:hunk-header "36") (:file-header "1;36") (t nil)))) (:hunk-header "36") (:file-header "1;36") (t nil))))
(if color (if color
(push (format nil "~c[~am~a~c[0m" #\Escape color line #\Escape) result) (push (format nil "~c[~am~a~c[0m" #\Esc color line #\Esc) result)
(push line result)))) (push line result))))
(nreverse result))) (nreverse result)))

View File

@@ -0,0 +1,12 @@
(defpackage :cl-tty.mouse
(:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering)
(:export
#:mouse-mixin
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
#:handle-mouse-event
#:hit-test
#:selection #:get-selection #:copy-to-clipboard
#:make-selection #:selection-p
#:start-selection #:update-selection #:finalize-selection
#:selection-active-p
#:cell-link-at #:open-link-at))

99
src/components/mouse.lisp Normal file
View File

@@ -0,0 +1,99 @@
(in-package :cl-tty.mouse)
(defclass mouse-mixin ()
((on-mouse-down :initarg :on-mouse-down :initform nil :accessor on-mouse-down)
(on-mouse-up :initarg :on-mouse-up :initform nil :accessor on-mouse-up)
(on-mouse-move :initarg :on-mouse-move :initform nil :accessor on-mouse-move)
(on-mouse-scroll :initarg :on-mouse-scroll :initform nil :accessor on-mouse-scroll)))
(defun handle-mouse-event (component event)
(let* ((type (mouse-event-type event))
(handler (case type
(:press (on-mouse-down component))
(:release (on-mouse-up component))
(:drag (on-mouse-move component))
(t nil))))
(when handler (funcall handler event))))
(defun hit-test (root x y)
(labels ((recurse (node)
(when (and (slot-exists-p node 'x) (slot-boundp node 'x)
(slot-exists-p node 'y) (slot-boundp node 'y)
(slot-exists-p node 'width) (slot-boundp node 'width)
(slot-exists-p node 'height) (slot-boundp node 'height))
(let ((nx (slot-value node 'x))
(ny (slot-value node 'y))
(nw (slot-value node 'width))
(nh (slot-value node 'height)))
(when (and (>= x nx) (< x (+ nx nw))
(>= y ny) (< y (+ ny nh)))
node)))))
(recurse root)))
;; Selection
(defvar *selection* nil)
(defstruct (selection (:conc-name sel-))
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
(defun get-selection ()
(when *selection* (sel-text *selection*)))
(defun copy-to-clipboard (text)
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
:input text :wait nil)
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
;;; --- Selection tracking (mouse drag) ---------------------------------------
(defvar *selection-active* nil
"T when a drag selection is in progress.")
(defvar *selection-start* nil
"Cons (X . Y) of mouse-down position during drag.")
(defvar *selection-end* nil
"Cons (X . Y) of current mouse position during drag.")
(defun start-selection (x y)
"Begin a drag selection at (X Y)."
(setf *selection-start* (cons x y)
*selection-end* (cons x y)
*selection-active* t))
(defun update-selection (x y)
"Update the drag selection end position to (X Y)."
(setf *selection-end* (cons x y)))
(defun selection-active-p ()
"Return T if a drag selection is in progress."
*selection-active*)
(defun finalize-selection (fb)
"End the drag selection and extract text from the framebuffer."
(setf *selection-active* nil)
(when (and *selection-start* *selection-end* fb)
(let* ((x1 (car *selection-start*))
(y1 (cdr *selection-start*))
(x2 (car *selection-end*))
(y2 (cdr *selection-end*))
(text (cl-tty.rendering:extract-text fb x1 y1 x2 y2)))
(setf *selection* (make-selection :start-x x1 :start-y y1
:end-x x2 :end-y y2
:text text))
(setf *selection-start* nil *selection-end* nil)
text)))
;;; --- Link clicking ---------------------------------------------------------
(defun cell-link-at (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(cl-tty.rendering:fb-cell-link-url fb x y))
(defun open-link-at (fb x y)
"If there is a link URL at (X Y) in FB, open it via xdg-open."
(let ((url (cell-link-at fb x y)))
(when url
#+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
#+darwin (sb-ext:run-program "open" (list url) :wait nil))
url))

View File

@@ -64,12 +64,12 @@
(when (> content-h viewport-h) (when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h)))) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :background-element) (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
(draw-text backend (1- viewport-w) thumb-pos "█" nil nil))) (draw-text backend (1- viewport-w) thumb-pos "█" nil nil)))
(when (> content-w viewport-w) (when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w)))) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :background-element) (draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
(draw-text backend thumb-pos (1- viewport-h) "█" nil nil))))) (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)

View File

@@ -0,0 +1,9 @@
(defpackage :cl-tty.slot
(:use :cl)
(:export
#:defslot
#:slot-render
#:slot-p
#:clear-slot
#:list-slots
#:*slots*))

27
src/components/slot.lisp Normal file
View File

@@ -0,0 +1,27 @@
(in-package :cl-tty.slot)
(defvar *slots* (make-hash-table :test #'equal)
"Hash table mapping slot name (string) -> list of (order . render-fn) pairs.")
(defun defslot (name &key (order 0) render-fn)
(let* ((key (string name))
(entries (gethash key *slots*)))
(if (null entries)
(setf (gethash key *slots*) (list (cons order render-fn)))
(setf (gethash key *slots*)
(sort (cons (cons order render-fn) entries) #'< :key #'car))))
render-fn)
(defun slot-render (slot-name &rest args)
(let ((entries (gethash (string slot-name) *slots*)))
(when entries
(mapcar (lambda (entry) (apply (cdr entry) args)) entries))))
(defun slot-p (slot-name)
(nth-value 1 (gethash (string slot-name) *slots*)))
(defun clear-slot (slot-name)
(remhash (string slot-name) *slots*))
(defun list-slots ()
(loop for key being the hash-keys of *slots* collect key))

View File

@@ -1,16 +1,5 @@
(in-package #:cl-tty.input) (in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation)
;;; ---------------------------------------------------------------------------
(defun %split-string (string separator)
"Split STRING at each occurrence of SEPARATOR. Returns list of strings."
(loop with start = 0
for pos = (position separator string :start start)
collect (subseq string start pos)
while pos
do (setf start (1+ pos))))
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; Textarea class ;;; Textarea class
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
@@ -169,10 +158,10 @@
"Save current value on undo stack." "Save current value on undo stack."
(let ((stack (textarea-undo-stack ta))) (let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack)) (when (>= (length stack) (array-total-size stack))
(setf (textarea-undo-stack ta) (loop for i from 1 below (length stack)
(make-array 100 :fill-pointer 0))) do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack) (vector-push (textarea-value ta) stack)
;; Clear redo stack on new action
(setf (fill-pointer (textarea-redo-stack ta)) 0))) (setf (fill-pointer (textarea-redo-stack ta)) 0)))
(defun textarea-undo (ta) (defun textarea-undo (ta)

View File

@@ -0,0 +1,219 @@
(defpackage :cl-tty.rendering
(:use :cl :cl-tty.backend)
(:export
#:cell #:make-cell #:cell-char #:cell-fg #:cell-bg
#:cell-bold #:cell-italic #:cell-underline #:cell-link-url
#:framebuffer-backend #:make-framebuffer-backend
#:make-framebuffer #:fb-framebuffer
#:framebuffer-width #:framebuffer-height
#:diff-framebuffers #:flush-framebuffer
#:with-scissor
#:extract-text #:fb-cell-link-url))
(in-package :cl-tty.rendering)
;;; ─── Cell — immutable per-cell state ─────────────────────────────────────────
(defstruct cell
"A single terminal cell — character, colors, and attributes."
(char #\space :type character)
(fg nil)
(bg nil)
(bold nil :type boolean)
(italic nil :type boolean)
(underline nil :type boolean)
(link-url nil))
;;; ─── Framebuffer — 2D array of cells ────────────────────────────────────────
(defun make-framebuffer (width height)
"Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
(make-array (list height width)
:initial-element (make-cell)
:element-type 'cell))
(defun framebuffer-width (fb)
"Return the width (columns) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 1) 0))
(defun framebuffer-height (fb)
"Return the height (rows) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 0) 0))
;;; ─── Framebuffer Backend — implements backend protocol ─────────────────────
(defclass framebuffer-backend (backend)
((framebuffer :initform nil :accessor fb-framebuffer)
(scissor-x :initform 0 :accessor fb-scissor-x)
(scissor-y :initform 0 :accessor fb-scissor-y)
(scissor-w :initform nil :accessor fb-scissor-w)
(scissor-h :initform nil :accessor fb-scissor-h)))
(defun make-framebuffer-backend (&key (width 80) (height 24))
"Create a framebuffer-backend with a fresh framebuffer."
(let ((fb (make-instance 'framebuffer-backend)))
(setf (fb-framebuffer fb) (make-framebuffer width height))
fb))
;;; ─── Drawing methods ─────────────────────────────────────────────────────────
(defun %in-scissor-p (fb cx cy)
"Check if (CX, CY) falls within the current scissor rectangle."
(let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
(sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
(and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
(or (null sh) (and (>= cy sy) (< cy (+ sy sh)))))))
(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
"Set cell (X, Y) if within bounds and scissor."
(let ((cells (fb-framebuffer fb)))
(when (and (>= y 0) (< y (framebuffer-height cells))
(>= x 0) (< x (framebuffer-width cells))
(%in-scissor-p fb x y))
(setf (aref cells y x)
(make-cell :char char :fg fg :bg bg
:bold bold :italic italic :underline underline
:link-url link-url)))))
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
&key bold italic underline reverse dim blink
(link-url nil link-url-p)
&allow-other-keys)
(declare (ignore reverse dim blink link-url-p))
(loop for i from 0 below (length string)
do (%set-cell fb (+ x i) y (char string i)
:fg fg :bg bg
:bold bold :italic italic :underline underline
:link-url link-url)))
(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
(dotimes (row h)
(dotimes (col w)
(%set-cell fb (+ x col) (+ y row) #\space :fg nil :bg bg))))
(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
(let* ((chars (case style
(:single '(#\+ #\- #\|))
(:double '(#\+ #\= #\|))
(:rounded '(#\. #\- #\|))
(t '(#\+ #\- #\|))))
(tc (first chars)) (hc (second chars)) (vc (third chars)))
;; Top edge
(%set-cell fb x y tc :fg fg :bg bg)
(loop for i from 1 below (1- w) do (%set-cell fb (+ x i) y hc :fg fg :bg bg))
(%set-cell fb (1- (+ x w)) y tc :fg fg :bg bg)
;; Sides
(dotimes (row (- h 2))
(%set-cell fb x (+ y row 1) vc :fg fg :bg bg)
(%set-cell fb (1- (+ x w)) (+ y row 1) vc :fg fg :bg bg))
;; Bottom edge
(%set-cell fb x (+ y h -1) tc :fg fg :bg bg)
(loop for i from 1 below (1- w) do (%set-cell fb (+ x i) (+ y h -1) hc :fg fg :bg bg))
(%set-cell fb (1- (+ x w)) (+ y h -1) tc :fg fg :bg bg)
;; Title
(when title
(loop for i from 0 below (length title)
do (%set-cell fb (+ x 2 i) y (char title i) :fg fg :bg bg)))))
(defmethod backend-clear ((fb framebuffer-backend))
(let ((cells (fb-framebuffer fb)))
(dotimes (y (framebuffer-height cells))
(dotimes (x (framebuffer-width cells))
(setf (aref cells y x) (make-cell))))))
(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
;; OSC 8 links are not rendered in framebuffer — store as text
(draw-text fb x y string fg bg :link-url url))
(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
(dotimes (i (min 3 width))
(%set-cell fb (+ x i) y #\. :fg fg :bg bg)))
;;; ─── Diff ────────────────────────────────────────────────────────────────────
(defun cells-equal-p (a b)
"Return T if two cells have identical content and style."
(and (eql (cell-char a) (cell-char b))
(eql (cell-fg a) (cell-fg b))
(eql (cell-bg a) (cell-bg b))
(eql (cell-bold a) (cell-bold b))
(eql (cell-italic a) (cell-italic b))
(eql (cell-underline a) (cell-underline b))
(equal (cell-link-url a) (cell-link-url b))))
(defun diff-framebuffers (prev curr)
"Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
(let ((changes nil)
(h (min (framebuffer-height prev) (framebuffer-height curr)))
(w (min (framebuffer-width prev) (framebuffer-width curr))))
(dotimes (y h)
(dotimes (x w)
(let ((a (aref prev y x)) (b (aref curr y x)))
(unless (cells-equal-p a b)
(push (list x y b) changes)))))
(nreverse changes)))
;;; ─── Flush ───────────────────────────────────────────────────────────────────
(defun flush-framebuffer (prev-fb curr-fb backend)
"Diff PREV-FB and CURR-FB and flush changes to BACKEND.
Returns the number of changed cells."
(let* ((changes (diff-framebuffers prev-fb curr-fb))
(count (length changes))
(current-row -1))
(when (plusp count)
(begin-sync backend)
(dolist (change changes)
(destructuring-bind (x y cell) change
(unless (= y current-row)
(cursor-move backend x y)
(setf current-row y))
(draw-text backend x y (string (cell-char cell))
(cell-fg cell) (cell-bg cell)
:bold (cell-bold cell)
:italic (cell-italic cell)
:underline (cell-underline cell))))
(end-sync backend))
count))
;;; --- Frame inspection ---------------------------------------------------
(defun fb-cell-link-url (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
(>= x 0) (< x (array-dimension fb 1)))
(let ((c (aref fb y x)))
(cell-link-url c))))
(defun extract-text (fb x1 y1 x2 y2)
"Extract visible text from the rectangle between (X1,Y1) and (X2,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)
(loop for y from y-min to (min y-max (1- h))
do (loop for x from x-min to (min x-max (1- w))
do (let ((c (aref fb y x)))
(princ (cell-char c) s)))
(when (< y y-max) (princ #\Newline s))))))
;;; ─── Scissor clipping ────────────────────────────────────────────────────────
(defmacro with-scissor ((fb x y w h) &body body)
"Clip all drawing on FB to rectangle (X Y W H)."
(let ((old-x (gensym)) (old-y (gensym))
(old-w (gensym)) (old-h (gensym)))
`(let ((,old-x (fb-scissor-x ,fb))
(,old-y (fb-scissor-y ,fb))
(,old-w (fb-scissor-w ,fb))
(,old-h (fb-scissor-h ,fb)))
(setf (fb-scissor-x ,fb) ,x
(fb-scissor-y ,fb) ,y
(fb-scissor-w ,fb) ,w
(fb-scissor-h ,fb) ,h)
(unwind-protect (progn ,@body)
(setf (fb-scissor-x ,fb) ,old-x
(fb-scissor-y ,fb) ,old-y
(fb-scissor-w ,fb) ,old-w
(fb-scissor-h ,fb) ,old-h)))))

View File

@@ -0,0 +1,97 @@
(defpackage :cl-tty-framebuffer-test
(:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
(in-package :cl-tty-framebuffer-test)
(def-suite framebuffer-suite :description "Framebuffer rendering pipeline tests")
(in-suite framebuffer-suite)
(test make-framebuffer-creates-correct-size
(let ((fb (make-framebuffer 80 24)))
(is (= 24 (framebuffer-height fb)))
(is (= 80 (framebuffer-width fb)))))
(test cell-defaults-are-space
(let ((cell (aref (make-framebuffer 10 10) 0 0)))
(is (eql #\space (cell-char cell)))
(is (null (cell-fg cell)))
(is (null (cell-bg cell)))))
(test draw-text-on-fb-sets-cells
(let ((fb (make-framebuffer-backend)))
(draw-text fb 2 3 "abc" :red nil)
(let ((cells (fb-framebuffer fb)))
(is (eql #\a (cell-char (aref cells 3 2))))
(is (eql #\b (cell-char (aref cells 3 3))))
(is (eql #\c (cell-char (aref cells 3 4))))
(is (eql :red (cell-fg (aref cells 3 2)))))))
(test draw-text-clips-at-bounds
(let ((fb (make-framebuffer-backend :width 10 :height 5)))
(draw-text fb 8 2 "hello" nil nil)
(let ((cells (fb-framebuffer fb)))
(is (eql #\h (cell-char (aref cells 2 8))))
(is (eql #\e (cell-char (aref cells 2 9))))
(is (eql #\space (cell-char (aref cells 2 0))) "out of bounds text is ignored"))))
(test diff-identical-fbs-returns-empty
(let ((fb1 (make-framebuffer 80 24))
(fb2 (make-framebuffer 80 24)))
(is (null (diff-framebuffers fb1 fb2)))))
(test diff-changed-fb-returns-changes
(let* ((fb1 (make-framebuffer 10 10))
(fb2 (make-framebuffer 10 10)))
(setf (aref fb2 5 5) (make-cell :char #\X :fg :red))
(let ((changes (diff-framebuffers fb1 fb2)))
(is (= 1 (length changes)))
(destructuring-bind (x y cell) (first changes)
(is (= 5 x))
(is (= 5 y))
(is (eql #\X (cell-char cell)))))))
(test with-scissor-clips-drawing
(let ((fb (make-framebuffer-backend :width 20 :height 10)))
(with-scissor (fb 5 5 3 3)
(draw-text fb 6 6 "ABC" nil nil)
(draw-text fb 1 1 "OUTSIDE" nil nil))
(let ((cells (fb-framebuffer fb)))
(is (eql #\A (cell-char (aref cells 6 6))) "inside scissor draws")
(is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))
(test flush-fb-copies-to-backend
(let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
(fb (make-framebuffer-backend)))
(draw-text fb 0 0 "X" :red nil)
(let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
(is (>= changed 1)))))
;; ── Frame inspection ──────────────────────────────────────────
(test fb-cell-link-url-returns-nil-for-blank-cell
(let ((fb (make-framebuffer 10 10)))
(is (null (fb-cell-link-url fb 5 5)))))
(test fb-cell-link-url-finds-link-url
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "click" nil nil :link-url "https://example.com")
(is (equal "https://example.com" (fb-cell-link-url (fb-framebuffer fb) 0 0)))
(is (null (fb-cell-link-url (fb-framebuffer fb) 5 5)))))
(test fb-cell-link-url-out-of-bounds-returns-nil
(let ((fb (make-framebuffer 5 5)))
(is (null (fb-cell-link-url fb 10 10)))))
(test extract-text-single-row
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "hello" nil nil)
(let ((cells (fb-framebuffer fb)))
(is (equal "hello" (extract-text cells 0 0 4 0))))))
(test extract-text-multi-row
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "abc" nil nil)
(draw-text fb 0 1 "def" nil nil)
(let* ((cells (fb-framebuffer fb))
(text (extract-text cells 0 0 2 1)))
(is (equal "abc
def" text)))))

View File

@@ -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)))

49
tests/mouse-tests.lisp Normal file
View File

@@ -0,0 +1,49 @@
(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
(in-package :cl-tty-mouse-test)
(def-suite mouse-suite :description "Mouse tests")
(in-suite mouse-suite)
(def-test mouse-mixin-create ()
(let ((m (make-instance 'mouse-mixin)))
(is-true (typep m 'mouse-mixin))))
(def-test mouse-hit-test-point ()
"hit-test returns nil when no component has position slots bound"
(let ((obj (make-instance 'mouse-mixin)))
(is-false (hit-test obj 0 0))
(is-false (hit-test obj 100 100))))
(def-test selection-set-and-get ()
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
(is (equal "hello" (get-selection))))
;; ── Selection tracking ──────────────────────────────────────
(def-test start-selection-initializes-state ()
(start-selection 5 10)
(is-true (selection-active-p))
(is (equal '(5 . 10) cl-tty.mouse::*selection-start*))
(is (equal '(5 . 10) cl-tty.mouse::*selection-end*))
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
(def-test update-selection-moves-end ()
(start-selection 0 0)
(update-selection 3 7)
(is (equal '(3 . 7) cl-tty.mouse::*selection-end*))
(setf cl-tty.mouse::*selection-active* nil
cl-tty.mouse::*selection-start* nil
cl-tty.mouse::*selection-end* nil))
(def-test finalize-selection-extracts-text ()
(let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
(fb (cl-tty.rendering:fb-framebuffer fb-be)))
(cl-tty.backend:draw-text fb-be 0 0 "hello" nil nil)
(cl-tty.backend:draw-text fb-be 0 1 "world" nil nil)
(start-selection 0 0)
(update-selection 4 1)
(let ((text (finalize-selection fb)))
(is (equal "hello
world" text)))))

26
tests/slot-tests.lisp Normal file
View File

@@ -0,0 +1,26 @@
(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
(in-package :cl-tty-slot-test)
(def-suite slot-suite :description "Slot system tests")
(in-suite slot-suite)
(def-test defslot-register ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "hello"))
(is-true (slot-p :test-slot)))
(def-test slot-render-calls ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "a"))
(defslot :test-slot :order 2 :render-fn (lambda () "b"))
(is (equal '("a" "b") (slot-render :test-slot))))
(def-test slot-render-empty ()
(clear-slot :ghost)
(is-false (slot-render :ghost)))
(def-test clear-slot-removes ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "x"))
(clear-slot :test-slot)
(is-false (slot-p :test-slot)))