Repository: ebpa/tui.el Branch: master Commit: 1bcf29c6516d Files: 94 Total size: 326.3 KB Directory structure: gitextract_p3spdelt/ ├── .dir-locals.el ├── .gitignore ├── .travis.yml ├── COMPONENTS.org ├── COPYING ├── Cask ├── README.org ├── benchmark/ │ ├── basic.el │ ├── breadth.el │ ├── depth.el │ └── update.el ├── components/ │ ├── test-tui-button.el │ ├── tui-buffer.el │ ├── tui-button.el │ ├── tui-canvas.el │ ├── tui-div.el │ ├── tui-expander.el │ ├── tui-fixed-width.el │ ├── tui-heading.el │ ├── tui-icon.el │ ├── tui-line.el │ ├── tui-link.el │ ├── tui-ol.el │ ├── tui-prefix-lines.el │ ├── tui-section.el │ ├── tui-span.el │ ├── tui-spinner.el │ ├── tui-timer.el │ └── tui-ul.el ├── demo/ │ ├── tui-demo.el │ └── tui-tic-tac-toe.el ├── layout/ │ └── tui-absolute-container.el ├── snippets/ │ └── emacs-lisp-mode/ │ ├── keyword-component-did-mount │ ├── keyword-component-did-update │ ├── keyword-component-will-unmount │ ├── keyword-get-default-props │ ├── keyword-get-derived-state-from-props │ ├── keyword-get-initial-state │ ├── keyword-render │ ├── keyword-should-component-update │ ├── tui-define-component │ └── tui-get-props ├── test/ │ ├── components/ │ │ ├── tui-buffer-test.el │ │ ├── tui-div-test.el │ │ ├── tui-expander-test.el │ │ ├── tui-fixed-width-test.el │ │ ├── tui-heading-test.el │ │ ├── tui-link-test.el │ │ ├── tui-overlay-test.el │ │ ├── tui-popup-test.el │ │ ├── tui-prefix-lines-test.el │ │ ├── tui-sparkline-test.el │ │ └── tui-tree-test.el │ ├── layout/ │ │ └── tui-absolute-container-test.el │ ├── tui-buttercup-matchers.el │ ├── tui-core-test.el │ ├── tui-defun.el │ ├── tui-dev-test.el │ ├── tui-layout-test.el │ ├── tui-marker-list-test.el │ ├── tui-reconciler-test.el │ ├── tui-shared-size-test.el │ ├── tui-tabstops-test.el │ ├── tui-test-helper.el │ ├── tui-test.el │ ├── tui-text-props-test.el │ └── tui-util-test.el ├── tui-components.el ├── tui-core.el ├── tui-defun.el ├── tui-demos.el ├── tui-dev.el ├── tui-dom.el ├── tui-errors.el ├── tui-hooks.el ├── tui-html.el ├── tui-inspect.el ├── tui-layout.el ├── tui-live-reloading.el ├── tui-log.el ├── tui-marker-list.el ├── tui-node-types.el ├── tui-plist.el ├── tui-reconciler.el ├── tui-ref.el ├── tui-shared-size.el ├── tui-snippets.el ├── tui-tabstops.el ├── tui-text-props.el ├── tui-traversal.el ├── tui-type-helpers.el ├── tui-util-ui.el ├── tui-util.el └── tui.el ================================================ FILE CONTENTS ================================================ ================================================ FILE: .dir-locals.el ================================================ ;;; Directory Local Variables ;;; For more information see (info "(emacs) Directory Variables") ((nil . ((lexical-binding . t)))) ================================================ FILE: .gitignore ================================================ /.cask *.elc *-pkg.el .yas-compiled-snippets.el .flycheck_*.el ================================================ FILE: .travis.yml ================================================ language: emacs-lisp env: - EMACS=emacs-26 - EMACS=emacs-snapshot matrix: fast_finish: true allow_failures: - env: EMACS=emacs-26 notifications: webhooks: urls: - https://webhooks.gitter.im/e/b20151e961756602ed9a on_success: change # options: [always|never|change] default: always on_failure: always # options: [always|never|change] default: always on_start: never # default: false # branches: # only: # - master before_install: - if [ "$EMACS" = 'emacs-26' ]; then sudo add-apt-repository -y ppa:kelleyk/emacs && sudo apt-get update && sudo apt-get -q install -y emacs26 ; fi # https://launchpad.net/~ubuntu-elisp/+archive/ppa - if [ "$EMACS" = 'emacs-snapshot' ]; then sudo add-apt-repository -y ppa:ubuntu-elisp/ppa && sudo apt-get -q update && sudo apt-get -q -f install && sudo apt-get -q install -y emacs-snapshot emacs-snapshot-el ; fi - git clone --depth=1 https://github.com/cask/cask.git "${HOME}/.cask" install: - ${HOME}/.cask/bin/cask install script: - $EMACS --version - ${HOME}/.cask/bin/cask exec buttercup -L . ================================================ FILE: COMPONENTS.org ================================================ * Components | Tui Component | Emacs Widget | HTML Element | |------------------+--------------+--------------| | tui-buffer | | | | tui-button | | button | | tui-canvas | | | | tui-div | | div | | tui-expander | | n/a | | tui-fixed-width | | | | tui-heading | | h1 | | tui-icon | | | | tui-line | | | | tui-link | | a | | tui-ol | | ol | | tui-prefix-lines | | n/a | | tui-section | | section | | tui-span | | span | | tui-spinner | | | | tui-timer | | | | tui-ul | | ul | ================================================ FILE: COPYING ================================================ GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. 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 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 which 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. Copyright (C) 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 . 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: Copyright (C) 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 . 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 . ================================================ FILE: Cask ================================================ (source gnu) (source melpa) (package-file "tui.el") (files :defaults ("components" "components/*.el") ("snippets/emacs-lisp-mode" "snippets/emacs-lisp-mode/*") ("demo" "demo/*.el") ("layout" "layout/*.el")) (development (depends-on "buttercup") (depends-on "undercover")) ================================================ FILE: README.org ================================================ * tui.el :PROPERTIES: :ID: ddb48016-ee39-4503-a61d-7f37c4032022 :pin: t :label: An experimental UI framework for Emacs inspired by React :keywords: ui-framework emacs :END: #+HTML: #+COMMENT: Badges [[http://www.gnu.org/licenses/gpl-3.0.txt][file:https://img.shields.io/badge/license-GPL_3-green.svg]] [[https://travis-ci.org/ebpa/tui.el][file:https://api.travis-ci.org/ebpa/tui.el.svg?branch=master]] #+COMMENT: [[https://coveralls.io/github/ebpa/tui?branch=master][file:https://coveralls.io/repos/ebpa/tui/badge.svg?branch=master&service=github]] #+COMMENT: [[http://melpa.org/#/tui][file:http://melpa.org/packages/tui-badge.svg]] #+COMMENT: [[http://stable.melpa.org/#/tui][file:http://stable.melpa.org/packages/tui-badge.svg]] ⚠ *Requires emacs version 26.1 or higher* ⚠ ** Introduction :PROPERTIES: :pin: 0 :ID: 8ff5465c-8ffc-4237-8302-964fbaab6454 :END: This is an experiment in building purely text-based user interfaces (TUI's). The ultimate goal is to explore new paradigms for user interface design and development using Emacs. To this end, tui.el implements an API based on the popular React JavaScript framework in order to reduce the demands involved with designing and building complex text-based UI's. This is all currently experimental! Expect things to change as I get feedback about what works, what does not! ** Installing :PROPERTIES: :pin: 2 :ID: 21c4d574-5de0-43ac-ae9d-444b2cbc5b86 :END: *** Using Straight.el :PROPERTIES: :ID: b106a1f4-3817-4ab8-b3f8-0e8b2d09a4b6 :END: #+begin_src emacs-lisp (straight-use-package '(tui :type git :host github :repo "ebpa/tui.el" :files ("*.el" "components" "layout" "demo" "snippets"))) #+end_src *** Manually :PROPERTIES: :ID: 5fde6a5c-ba8b-42de-898c-95c03d4af06a :END: The package hasn't been submitted to Melpa yet. To install the package manually: clone the repository, add the folder to your load path and install the dependencies with the following: #+begin_src sh git clone git@github.com:ebpa/tui.el.git #+end_src #+begin_src emacs-lisp :tangle yes (add-to-list 'load-path "~/path/to/tui.el") (require 'package) (add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/") t) (package-initialize) (package-refresh-contents) ;; Manually install package dependencies (package-install 'dash) (package-install 's) #+end_src ** Getting started :PROPERTIES: :pin: 3 :ID: 2ed4f7e4-4982-429c-974d-c07ce9cc5d3b :END: **** Tic Tac Toe :PROPERTIES: :ID: cd178658-1421-4a82-abaa-f7d73659bdd6 :END: Tui contains a tic tac toe game as a demonstration component. You can play the game with `M-x tui-play-tic-tac-toe`. Check out the source code with `M-x find-function "tui-play-tic-tac-toe"`. **** Rendering content :PROPERTIES: :ID: 8e45f5bf-b357-4491-aff3-0117080f8dff :END: If all goes well you should be able to require the library and render something to the buffer. The following will render a greeting at the point. #+begin_src emacs-lisp (tui-render-element "Hello world!") #+end_src # **Note: The `(progn ... nil)` wrapper is a recommended measure to avoid printing the value returned by `tui-render-element` when calling it using `eval-last-sexp` or `eval-expression`. Printing the complex object can cause Emacs hang badly.** **** Defining a component :PROPERTIES: :ID: 1f39155a-2c9a-4688-a24c-7c6c4b3e2c9d :END: Tui components are defined using `tui-define-component`. ** Overview :PROPERTIES: :pin: 4 :ID: 55b5d38e-176e-4cdb-8700-9994991e0b6c :END: Some familiarity with React should prove extremely helpful in using tui.el. I recommend checking out the [[https://reactjs.org/docs/hello-world.html][introductory material]] on the React website. In particular- be sure to read the short primer on [[https://reactjs.org/docs/thinking-in-react.html][Thinking in React]] and the component [[https://reactjs.org/docs/state-and-lifecycle.html][lifecycle model]] ([[http://dbertella.github.io/react-lifecycle-svg/][diagram]]). *** Syntax :PROPERTIES: :pin: 0 :ID: e26942ae-3363-4020-91d7-53a051a2daa5 :END: Tui offers an terse syntax for expressing content that roughly resembles the form of JSX. For instance, an expander control consists of a header and some content that is hidden when collapsed by the user: #+BEGIN_EXAMPLE elisp (tui-expander :heading "A label for the following collapsible lorem ipsum content" "Curabitur lacinia pulvinar nibh. " "Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. " "Sed id ligula quis est convallis tempor. ") #+END_EXAMPLE Inititial arguments as parsed key-value pairs and are passed as a [[https://www.emacswiki.org/emacs/AlistVsPlist][plist]] to an element. A non-[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Symbol-Type.html][keyword-symbol]] following the property list and all following elements are treated as child elements. They are implicitly passed with the preceding plist properties as a value for ~:children~. This avoids unnecessary repetition in typing ~:children~. #+BEGIN_EXAMPLE elisp (COMPONENT-NAME [[KEYWORD-PROP VALUE] ...] [CHILD-1 CHILD-2 ...]) #+END_EXAMPLE The verbose equivalent to this syntax explicitly expresses the ~:children~ property. Note that multiple items must be enclosed by a single list or other element to follow the paired plist structure. The resulting content tree is identical to the previous example. #+BEGIN_EXAMPLE elisp (tui-expander :heading "A label for the following collapsible lorem ipsum content" :children (list "Curabitur lacinia pulvinar nibh. " "Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. " "Sed id ligula quis est convallis tempor. ")) #+END_EXAMPLE *** Lists (and nil) :PROPERTIES: :ID: 627c7dde-7948-4ce6-80d7-2b728f8ee8d7 :END: For convenience, lists may be used to arbitrarily group content. All lists are converted to ~tui-element~ nodes when the content is mounted. Null values may also be used arbitrarily. They are ignored at render time, so conditional code may return ~nil~. Content is inserted in-order without separation, so while ~(list "foo" "bar" "baz")~ and ~(list (list "foo") nil (list "bar" "baz"))~ result in different content trees, they both render ~"foobarbaz"~. The various forms of improper lists are currently not supported and are reserved for future use. *** Text properties :PROPERTIES: :pin: t :ID: 8a74a2f8-b56e-4947-9fcb-50e2feb2bca9 :END: To simplify styling, text properties may be applied to elements using the keyword :text-props. This property value should be a plist of text properties and their values. For example: #+BEGIN_EXAMPLE elisp (tui-heading :text-props '(help-echo "Yup! This is a heading") "A heading!") #+END_EXAMPLE *** Comparison with React :PROPERTIES: :ID: 206d4692-e371-432b-8aee-c413b56ec6bc :END: **** ReactJS equivalents :PROPERTIES: :pin: t :ID: 2a9d46b9-99d7-4955-9cee-34dfefe007c4 :END: | ReactJS | tui.el | |---------------------+------------------------------------| | React.Component | tui-component | | React.PureComponent | TODO | | createElement() | tui-create-element | | createFactory() | tui-define-component | | cloneElement() | TODO | | isValidElement() | tui-valid-element-p | | React.Children | unnecessary (use tui-child-nodes) | ** Components :PROPERTIES: :ID: f0470d65-9cbd-4737-a43f-d5ab759e302a :pin: t :END: *** HTML-like components :PROPERTIES: :ID: 0cbcd6e4-c0b7-46b0-96b1-1cf773a14854 :END: | (tui-div &key children) | | (tui-heading &key children) | | (tui-section &key children) | | (tui-span &key children) | *** Other components :PROPERTIES: :ID: c16cb7c3-5ef6-4a0a-8aff-b72079287d39 :END: | (tui-link &key target children) | | (tui-icon &key icon-set icon-name) | | (tui-buffer &key buffer children) | | (tui-line &key children) | | (tui-fixed-width &key children) | | (tui-expander &key header initially-expanded children) | ** Future Work :PROPERTIES: :ID: 1f235263-6406-48e7-8f11-97f197c5b046 :END: Things I'm currently working on: - [ ] Grid layout - [ ] TUI Developer tools ** Contributing :PROPERTIES: :pin: -2 :ID: 6a69022c-a3cd-49e5-bcea-b0ba6cf8c399 :END: If you feel inspired by this little library, contact me on [[https://twitter.com/ebanders][Twitter]] and let me know! The door is wide open for collaboration! If you have ideas for components I'd love to hear them. *** Ideas :PROPERTIES: :ID: bebe96a2-0e53-4d65-95d4-25e966f5a300 :END: Here are a few things I have in mind in case you're looking for an excuse to explore Emacs' many features: **** org-agenda :PROPERTIES: :ID: 8cd1cff5-fb7d-4b52-92ac-ddba1eb43332 :END: There are a lot of opportunities for customizing the org-mode agenda view that could be made possible with components designed for org-mode. [[https://github.com/alphapapa/org-super-agenda][Org-super-agenda]] offers striking examples of grouping agenda content into meaningful elements. **** Structure editors :PROPERTIES: :ID: beb31dcd-9119-4be3-97e0-54191021171b :END: [[https://en.wikipedia.org/wiki/Structure_editor][Structure editors]] are an exciting approach for editing source code and structured data. Build a set of components for representing and interacting with a syntax conceivably eliminates syntax errors altogether! **** Charts and graphs :PROPERTIES: :ID: d6690ba7-0f06-47c1-bad0-d81c4e126cff :END: It would be very handy to have a variety of charts and graphs to visualize data within Emacs itself. Emacs already has a good start with the built-in ~chart.el~ for bar charts ([[http://francismurillo.github.io/2017-04-15-Exploring-Emacs-chart-Library/][examples]]). This would be a good application for [[https://github.com/josuah/drawille][drawille.el]]. Fancy animated charts like [[https://github.com/yaronn/blessed-contrib][blessed-contrib]] anyone? **** Virtual windows :PROPERTIES: :ID: fdeac707-5fdb-4df9-8eb7-261e825976b2 :END: There are circumstances where it would be useful to create divisions within a buffer/window without the behavior associated with additional windows. Imagine various tiled/floating window behavior demonstrated by [[https://github.com/chjj/blessed][blessed]] within a single buffer. **** Touch-based interfaces :PROPERTIES: :ID: 8d8ec6cc-76ef-4e91-b8eb-3766bf572a82 :END: Why not give Emacs some big blocky buttons and sliders, so we can use our pervasive touchscreens with Emacs too? Or even: design progressive Emacs apps? *** Running Tests :PROPERTIES: :ID: 51d57590-60fb-4e42-bdaa-cc4660331d5d :pin: t :END: #+begin_src emacs-lisp cask exec buttercup -L #+end_src *** Feedback :PROPERTIES: :pin: t :ID: 22794aed-d57f-40aa-89de-f035b07ce89b :END: *** Requesting components :PROPERTIES: :pin: t :ID: e96ffc7a-0bf4-4152-b602-a4a9b38bae97 :END: **** Suggestions :PROPERTIES: :ID: dec07d98-7bf4-431d-9156-8a1a8cd13d44 :END: ***** Button :PROPERTIES: :ID: 82a612fa-b2ab-4fbf-898d-60d2c32b7111 :END: ***** Calendar :PROPERTIES: :ID: 72767a59-cdc4-4cbe-8f87-2baaf4d3a437 :END: ***** Dropdown :PROPERTIES: :ID: a10fbeab-f621-4344-8e91-24c33b62a405 :END: ***** GitHub-style punchcard :PROPERTIES: :ID: 953df8d3-f680-4639-81e9-0f8af83150ea :END: ***** Graphs/charts :PROPERTIES: :ID: d71ea581-9fbc-48d8-a1b0-aba7cc65888a :END: ***** Sparkline :PROPERTIES: :ID: 5d2e5217-250a-4c00-b309-b436747d9959 :END: ***** Week :PROPERTIES: :ID: 55637943-2b72-4251-b07f-70f2ef06d4eb :END: ** Related Projects :PROPERTIES: :pin: -1 :ID: 60d9ca3c-d01d-4d9c-97e8-7d0f4ede3066 :END: - *Emacs* - shr.el / eww - [[https://github.com/alezost/bui.el][bui.el: Buffer interface library for Emacs]] - [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Abstract-Display.html#Abstract-Display][ewoc: "Emacs's Widget for Object Collections"]] - *Non-Emacs* - [[https://en.wikipedia.org/wiki/Ncurses][ncurses]] - A good list: [[https://appliedgo.net/tui/][Text-Based User Interfaces · Applied Go]] - [[https://github.com/vadimdemedes/ink][vadimdemedes/ink: 🌈 React for interactive command-line apps]] - [[https://github.com/JoelOtter/termloop][JoelOtter/termloop: Terminal-based game engine for Go, built on top ...]] - [[https://github.com/VladimirMarkelov/clui][VladimirMarkelov/clui: Command Line User Interface (Console UI inspi...]] - [[https://github.com/chjj/blessed][chjj/blessed: A high-level terminal interface library for node.js.]] - [[https://github.com/cznic/wm][cznic/wm: Package wm is a terminal window manager.]] - [[https://github.com/gizak/termui][gizak/termui: Golang terminal dashboard]] - [[https://github.com/gyscos/Cursive][gyscos/Cursive: A Text User Interface library for rust]] - [[https://github.com/jroimartin/gocui][jroimartin/gocui: Minimalist Go package aimed at creating Console Us...]] - [[https://github.com/marcusolsson/tui-go][marcusolsson/tui-go: A UI library for terminal applications.]] - [[https://github.com/ticki/termion][ticki/termion: A bindless library for controlling terminals/TTY.]] - [[https://github.com/Yomguithereal/react-blessed][Yomguithereal/react-blessed: A react renderer for blessed.]] - [[https://github.com/manaflair/mylittledom][manaflair/mylittledom: High-level DOM-like terminal interface library]] - [[https://github.com/fdehau/tui-rs][fdehau/tui-rs: Build terminal user interfaces and dashboards using Rust]] - [[https://github.com/jtdaugherty/brick/][brick]] - A declarative terminal UI programming library written in Haskell - [[https://github.com/ceccopierangiolieugenio/pyTermTk][ceccopierangiolieugenio/pyTermTk: Python Terminal Toolkit]] ================================================ FILE: benchmark/basic.el ================================================ ;; TODO: 1000 lines ================================================ FILE: benchmark/breadth.el ================================================ ;; TODO: Element with 1000 children ================================================ FILE: benchmark/depth.el ================================================ ;; TODO: tree of depth 1000 ================================================ FILE: benchmark/update.el ================================================ ;; TODO: reordering ================================================ FILE: components/test-tui-button.el ================================================ (require 'buttercup) (describe "tui-button" (describe "without an action" (it "does nothing (/doesn't blow up)"))) ================================================ FILE: components/tui-buffer.el ================================================ ;;; tui-buffer.el --- Buffer container this -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-core) ;;; Code: (defvar-local tui-buffer--ref nil "Reference for local buffer logic.") (tui-define-component tui-buffer ;; TODO: suppoort both major and minor modes ;; TODO: support inheriting text properties? :documentation "Component representing a buffer." :prop-documentation ( :buffer "Buffer or buffer name to use or create." :children "Content to display in the buffer." :mode "Major mode to set in the buffer." :keymap "Local keymap to use in the buffer." :init-fn "Function to call after the buffer has been set up." ) :get-default-props (lambda () (list :mode 'special-mode)) :mount (lambda (this &optional start end parent) (let* ((props (tui--plist-merge (tui-get-default-props this) (tui--get-props this))) (buffer (get-buffer-create (or (plist-get props :buffer) (format " *tui-buffer-%d*" (tui-node-id this))))) (mode (plist-get props :mode)) (keymap (plist-get props :keymap)) (marker-list (tui-marker-list-create)) (init-fn (plist-get props :init-fn)) start end) (setf (tui-component-props this) props) (setf (tui-component-state this) (list :buffer-ref buffer)) (with-current-buffer buffer (let* ((inhibit-read-only t)) (when mode (funcall mode)) (erase-buffer) (push this tui--content-trees) (setq-local revert-buffer-function (lambda (ignore-auto noconfirm) (tui-force-update-buffer))) (setq-local tui-buffer--ref this) (when keymap (let* ((keymap (copy-keymap keymap))) (set-keymap-parent keymap (current-local-map)) (use-local-map keymap))) (setf (tui-node-marker-list this) marker-list) (setq start (tui-marker-list-insert marker-list (point-marker))) (setq end (cl-second (tui-marker-list-split-node marker-list start))) ;; (condition-case err (cl-call-next-method this start end parent marker-list) ;; (t (message "Error: %s" err))) ;; (make-local-variable 'after-change-functions) ;; (add-to-list 'after-change-functions #'tui-absolute-container--update-parent) (when init-fn (funcall init-fn)))) this)) :render (lambda (this) (tui-let* ((&props children buffer) this) (message "tui-buffer render() %s" buffer) children)) :component-did-update (lambda (this next-props next-state) (with-current-buffer (marker-buffer (tui-start this)) (-when-let* ((parent (tui-parent this 'tui-absolute-container))) (funcall #'tui-absolute-container--update-parent))))) (cl-defmethod tui--update ((this tui-buffer) &optional next-props next-state force) "Pass updates through to content." ;; (edebug) ;;tui-force-update ;; (mapcar #'tui--update (tui-component-content this)) (cl-call-next-method)) (cl-defmethod tui-buffer--get-content ((buffer tui-buffer)) "Return the `buffer-string' value for BUFFER." (let* ((buffer-ref (plist-get (tui--get-state buffer) :buffer-ref))) (with-current-buffer buffer-ref (buffer-string)))) (provide 'tui-buffer) ;;; tui-buffer.el ends here ================================================ FILE: components/tui-button.el ================================================ ;;; tui-button.el --- Basic button -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) (require 'tui-defun) ;;; Code: (tui-defun-2 tui-button (children action (face 'custom-button)) "A basic button control. ACTION is a function to bind to [mouse-1]." (declare (wip TODO "or mouse-2/multiple?")) (let* ((map (make-sparse-keymap)) ;; Interactive command necessary for keymap binding (interactive-action (if (interactive-form action) action `(lambda () (interactive) (funcall ,action))))) (define-key map [mouse-1] interactive-action) (tui-span :text-props-replace `(font-lock-ignore t font-lock-face ,face face ,face mouse-face highlight keymap ,map) children))) (with-eval-after-load 'tui-demo (tui-define-demo tui-button "Basic click action" (tui-button :action (lambda () (interactive) (message "Click!")) "Click Me"))) (provide 'tui-button) ;;; tui-button.el ends here ================================================ FILE: components/tui-canvas.el ================================================ ;;; tui-canvas.el --- Canvas component ;;; Commentary: ;; (tui-define-component tui-canvas :documentation "" :prop-documentation ( :initial-content "" ) :get-initial-state (lambda () (list :buffer (get-buffer-create (format " *tui-canvas-%d*" (tui-node-id component))) :canvas-content "")) :render (lambda () (tui-let (&state canvas-content) canvas-content))) (cl-defmethod tui-canvas-erase ((canvas tui-canvas) &optional no-update) "" (-let* ((buffer (plist-get (tui--get-state canvas) :buffer))) (with-current-buffer buffer (erase-buffer) (tui--set-state canvas `(:canvas-content ,(buffer-string)) no-update)))) (cl-defmethod tui-canvas--paste-content-at ((canvas tui-canvas) content x y &optional no-update) "Paste CONTENT in CANVAS at position X,Y" ;;(when (tui-mounted-p canvas) (-let* ((buffer (plist-get (tui--get-state canvas) :buffer))) (with-current-buffer buffer ;; Disable stickiness on inserted content to avoid bleeding of ;; properties across blank space by the insertion behavior within ;; move-to-column (used in artist-move-to-xy). (setq content (propertize content 'front-sticky nil 'rear-nonsticky t)) (cl-loop for line in (split-string content "\n") for line-num from 0 do (artist-move-to-xy x (+ y line-num)) (delete-region (point) (min (+ (point) (length line)) (save-excursion (end-of-line) (point)))) (when line (insert line))) (tui--set-state canvas `(:canvas-content ,(buffer-string)) no-update)))) (provide 'tui-canvas) ;;; tui-canvas.el ends here ================================================ FILE: components/tui-div.el ================================================ ;;; tui-div.el --- HTML 'div'-like component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-defun) ;;; Code: (tui-defun tui-div (children) "Component for grouping elements. Render with a newline before and after the child content." (list "\n" children "\n")) (provide 'tui-div) ;;; tui-div.el ends here ================================================ FILE: components/tui-expander.el ================================================ ;;; tui-expander.el --- Basic expander control -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'dash) (require 'tui-core) (require 'tui-span "components/tui-span.el") (require 'tui-prefix-lines "components/tui-prefix-lines.el") ;;; Code: (defvar tui-expander-keymap (let ((map (make-sparse-keymap))) (define-key map "+" 'tui-expander-expand) (define-key map "-" 'tui-expander-collapse) (define-key map "=" 'tui-expander-toggle-expansion) map) "Expander keymap.") (defvar tui-expander-glyph-keymap (let ((map (make-sparse-keymap))) (set-keymap-parent map tui-expander-keymap) (define-key map [mouse-1] 'tui-expander-toggle-expansion) (define-key map [space] 'tui-expander-toggle-expansion) (define-key map [return] 'tui-expander-toggle-expansion) map) "Expander keymap.") (defvar tui-default-expander-expand-glyph "▲" "Default glyph to use for displaying expander buttons.") (defvar tui-default-expander-collapse-glyph "▼" "Default glyph to use for displaying collapse buttons.") (defun tui--expander-glyph (expanded &optional expand-glyph collapse-glyph) "Internal helper to render a group's expander glyph button. Argument EXPANDED - whether the expander is expanded. Optional argument EXPAND-GLYPH - glyph to show when collapsed. Optional argument COLLAPSE-GLYPH - glyph to show when expanded." (declare (wip TODO "revise definition to easily substitute \"+/-\" glyphs")) (if expanded (tui-span :text-props `(help-echo "click to collapse" keymap ,tui-expander-keymap) (or collapse-glyph tui-default-expander-collapse-glyph)) (tui-span :text-props `(help-echo "click to expand" keymap ,tui-expander-keymap) (or expand-glyph tui-default-expander-expand-glyph)))) (defun tui-expander-expand (event) "Mouse function to expand expander at point of EVENT." (interactive "e") (tui-expander--expand (tui-expander-get-expander event))) (defun tui-expander--expand (&optional expander) "Collapse EXPANDER." (unless expander (setq expander (tui-expander-get-expander))) (tui--set-state expander '(:expanded t))) (defun tui-expander-collapse (event) "Mouse function to collapse expander at point of EVENT." (interactive "e") (tui-expander--collapse (tui-expander-get-expander event))) (defun tui-expander--collapse (&optional expander) "Collapse EXPANDER." (unless expander (setq expander (tui-expander-get-expander))) (tui--set-state expander '(:expanded nil))) (defun tui-expander-toggle-expansion (&optional expander) "Toggle expansion EXPANDER." (interactive) (unless expander (setq expander (tui-expander-get-expander))) (if (plist-get (tui--get-state expander) :expanded) (tui-expander--collapse expander) (tui-expander--expand expander))) (defun tui-expander-get-expander (&optional position-or-event) "Return the expander associated with POSITION-OR-EVENT." (when (eventp position-or-event) (setq position-or-event (posn-point (event-end position-or-event)))) (let ((position (or position-or-event (point)))) (tui-get-element-at position 'tui-expander))) (tui-define-component tui-expander :documentation "Expander component enables showing/hiding content below a supplied header." :prop-documentation ( :header "Shown regardless of whether expander is expanded or collapsed." :children "Content of the expander shown following the header." :initially-expanded "Whether the content of the expander should be initially be shown." :expanded-glyph "Glyph to display when the expander is in the expanded state." :collapsed-glyph "Glyph to display when the expander is in the collapsed state." ) :get-default-props (lambda () (list :initially-expanded t)) :get-initial-state (lambda (_) nil) :get-derived-state-from-props (lambda (_ props state) (when (not (plist-member state :expanded)) (list :expanded (plist-get props :initially-expanded)))) :render (lambda (_) (tui-let (&props header children collapsed-glyph expanded-glyph &state expanded) (tui-span :text-props `(keymap ,tui-expander-keymap) :replace-behavior nil (tui-span :text-props-replace `(font-lock-ignore t keymap ,tui-expander-glyph-keymap) (if expanded (or expanded-glyph "⊟") (or collapsed-glyph "⊞"))) " " header (tui-span :invisible (not expanded) children))))) (defun tui-demo-basic-expander () "Show a demonstration expander." (interactive) (tui-show-component-demo (tui-expander :header (tui-line "This is an expander") (tui-prefix-lines :prefix " " "Aliquam erat volutpat. Nunc eleifend leo vitae magna. In id erat non orci commodo lobortis. Proin neque massa, cursus ut, gravida ut, lobortis eget, lacus. Sed diam. Praesent fermentum tempor tellus. Nullam tempus. Mauris ac felis vel velit tristique imperdiet. Donec at pede. Etiam vel neque nec dui dignissim bibendum. Vivamus id enim. Phasellus neque orci, porta a, aliquet quis, semper a, massa. Phasellus purus. Pellentesque tristique imperdiet tortor. Nam euismod tellus id erat.\n")))) (defun tui-demo-nested-expander () "Show a demonstration of nested expanders." (interactive) (tui-show-component-demo (tui-expander :header (tui-line "This is an expander") (tui-prefix-lines :prefix " " (tui-line "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Donec hendrerit tempor tellus. Donec pretium posuere tellus. Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Nulla posuere. Donec vitae dolor. Nullam tristique diam non turpis. Cras placerat accumsan nulla. Nullam rutrum. Nam vestibulum accumsan nisl.") (tui-expander :header (tui-line "This is a nested expander") (tui-prefix-lines :prefix " " (tui-line "Aliquam erat volutpat. Nunc eleifend leo vitae magna. In id erat non orci commodo lobortis. Proin neque massa, cursus ut, gravida ut, lobortis eget, lacus. Sed diam. Praesent fermentum tempor tellus. Nullam tempus. Mauris ac felis vel velit tristique imperdiet. Donec at pede. Etiam vel neque nec dui dignissim bibendum. Vivamus id enim. Phasellus neque orci, porta a, aliquet quis, semper a, massa. Phasellus purus. Pellentesque tristique imperdiet tortor. Nam euismod tellus id erat."))))))) (provide 'tui-expander) ;;; tui-expander.el ends here ================================================ FILE: components/tui-fixed-width.el ================================================ ;;; tui-fixed-width.el --- Constrain contents to a fixed width -*- lexical-binding: t; -*- ;;; Commentary: ;; ;; Implementation possibilities ;; -'display text property ;; -'display overlay property ;; -delete overflow (and store as a property) (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-core) (require 'tui-shared-size) (require 'tui-layout) ;;; Code: (defvar tui-fixed-width--suppress-recalculation nil) (tui-define-component tui-fixed-width :documentation "Container component to constrain content to a declared width. It :width value is nil, the component width is variable." :prop-documentation (:minimum-padding "Minimum padding" :align "One of: `left', `center', `right'. (**not yet implemented**)" :width "Width (integer count of characters) or a shared width object.") :get-default-props (lambda () (list :minimum-padding 0 :align 'left)) :render (lambda (_) (tui-let (&props children align) (list "" children ""))) :component-did-mount (lambda (_) (unless tui-fixed-width--suppress-recalculation (tui-fixed-width--request-width component))) :component-did-update (lambda (_ pref-props prev-state) (tui-fixed-width--request-width component))) (defun tui-fixed-width--request-width (component) "Respond to a change in content size in COMPONENT." (lexical-let ((component component)) ;; TODO: is this needed? (-let* (((&plist :width desired-width :minimum-padding minimum-padding) (tui--get-props component))) (cond ((tui-shared-size-p desired-width) (tui-request-size desired-width (+ (tui-length (tui-fixed-width--content component)) (or minimum-padding 0)) component)) (desired-width (tui-fixed-width--update component)))))) (defun tui-fixed-width--update (component) "Update COMPONENT width." (-let* ((inhibit-read-only t) ((&plist :padding-node padding-node) (tui--get-state component)) ((&plist :width desired-width :minimum-padding minimum-padding) (tui--get-props component)) (padding-width nil) (overflow-length nil)) (when (and desired-width (not (eq desired-width 'variable)) (tui-mounted-p component)) ;; Shared width; we are only interested in its prescribed width (if (tui-shared-size-p desired-width) (setq desired-width (tui-size desired-width))) (cond ;; TODO: accept complex pixel specifications (https://www.gnu.org/software/emacs/manual/html_node/elisp/Pixel-Specification.html#Pixel-Specification) ;; TODO: testing of pixel-based widths ;; ((and desired-width ;; (listp desired-width)) ;; (-let* ((current-width (tui-pixel-width component)) ;; (desired-width (car desired-width)) ;; (width-difference (tui--width-difference desired-width current-width))) ;; (cond ;; ((> width-difference 0) ;; (setq padding-width (list width-difference))) ;; ((< width-difference 0) ;; (setq overflow-length (tui--overflow-length (tui-start component) (tui-end component) desired-width)) ;; (setq padding-width (list (- desired-width (tui-segment-pixel-width (tui-start component) (- (tui-end component) overflow-length))))))))) ((numberp desired-width) (let* ((content-length (tui-string-width (tui-fixed-width--content component)))) (tui--truncate-overflow component desired-width) (when (< content-length desired-width) (tui--set-padding component (- desired-width content-length))))) ((null desired-width)) (t (warn "Unknown width value format")))))) (defun tui-fixed-width--content (component) (second (tui-child-nodes component))) (defun tui--truncate-overflow (component length) "Truncate overflow of COMPONENT that overflows LENGTH characters." (let* ((content (tui-fixed-width--content component))) (when (> (tui-end component) (+ (tui-start component) length)) (with-current-buffer (marker-buffer (tui-start component)) (delete-region (+ (tui-start component) length) (tui-end component)))))) (defun tui--set-padding (component width) "Internal function to manually update the width of padding nodes." (-let* (((&plist :align align) (tui--get-props component)) (child-nodes (tui-child-nodes component))) (if (eq align 'center) (-let* (((left-padding content right-padding) child-nodes)) (tui--set-padding-node-width right-padding (/ width 2)) (tui--set-padding-node-width left-padding (- width (/ width 2)))) (let* ((padding (pcase align ('left (third child-nodes)) ('right (first child-nodes)) (_ (error "Unexpected alignment value: %S" align))))) (tui--set-padding-node-width padding width))))) (defun tui--set-padding-node-width (padding-node width) "Internal function to manually update the width of padding nodes." (tui--with-open-node padding-node (delete-region (tui-start padding-node) (tui-end padding-node)) (insert (propertize (make-string width ? ) 'font-lock-ignore t 'cursor-intangible t)) (tui--apply-inherited-text-props (tui-start padding-node) (tui-end padding-node) padding-node))) (provide 'tui-fixed-width) ;;; tui-fixed-width.el ends here ================================================ FILE: components/tui-heading.el ================================================ ;;; tui-heading.el --- HTML 'h1'-like component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: (tui-define-component tui-heading ;; TODO: support heading levels? (h1, h2, etc.) - as subcomponents? :documentation "HTML 'h1'-like component" :render (lambda () (tui-let (&props children) (tui-line (tui-span :text-props '(face org-level-1) :children children))))) (provide 'tui-heading) ;;; tui-heading.el ends here ================================================ FILE: components/tui-icon.el ================================================ ;;; tui-icon.el --- Icon helper component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: (defvar all-the-icons-font-families) (declare-function all-the-icons--family-name "all-the-icons.el") (declare-function all-the-icons--data-name "all-the-icons.el") (defvar tui--all-the-icons-size-data (make-hash-table :test #'equal) "Icon size data (WIDTH . HEIGHT). Keys formatted as (FAMILY . ICON-NAME).") (defun tui-build-icon-dimension-data () "Build a database of rendered icon dimensions." (interactive) (require 'all-the-icons) (or (tui-restore-icon-dimension-data) (save-current-buffer (let ((buffer (get-buffer-create "*icon-indexing*")) (test-scaling-factor 10.0)) (switch-to-buffer buffer) (erase-buffer) (let ((line-height (line-pixel-height)) (char-width (progn (insert " ") (tui-segment-pixel-width (point-min) (point-max))))) (erase-buffer) (mapc (lambda (family) (let ((family-name (funcall (all-the-icons--family-name family))) (data-alist (funcall (all-the-icons--data-name family)))) (mapcar (-lambda ((name . icon)) (insert (propertize icon 'font-lock-ignore t 'face (list :height test-scaling-factor))) (puthash (cons family name) (cons (/ (tui-segment-pixel-width (point-min) (point-max)) (* char-width test-scaling-factor)) (/ (line-pixel-height) (* line-height test-scaling-factor))) tui--all-the-icons-size-data) (erase-buffer)) data-alist))) all-the-icons-font-families)) (tui-save-icon-dimension-data) (kill-buffer buffer))))) (defvar tui--icon-dimension-path (concat user-emacs-directory "tui-icon-dimensions.el")) (defun tui-save-icon-dimension-data () "Persist stored icon dimensions." (save-current-buffer (with-current-buffer (find-file-noselect tui--icon-dimension-path) (erase-buffer) (print (list 'setq 'tui--all-the-icons-size-data (list 'quote tui--all-the-icons-size-data)) (current-buffer)) (save-buffer) (kill-buffer)))) (defun tui-restore-icon-dimension-data () "Load stored icon dimensions." (load tui--icon-dimension-path t)) (tui-define-component tui-icon ;; TODO: keep consistent with resized display ;; TODO: consider use of multiple characters for displaying an icon (ex: position a wide icon across two characters) ;; TODO: double character allocation for terminal characters ;; TODO: failover unicode icon for terminal (when a font family can't be specified) ;; TODO: implement a manual scaling mechanism ;; TODO: note that tui-icon requires all-the-icons :documentation "Currently only serves icons included in the package `all-the-icons'. Example: \(tui-icon :icon-set 'faicon :icon-name \"barcode\" :scaling nil)" :prop-documentation (:icon-set (format "One of symbols (%s)" (mapconcat #'symbol-name all-the-icons-font-families ", ")) :icon-name "Name of the desired icon as a string" :scaling "Explicit scaling factor (a number). Default value is t- indicating that the icon should be scaled to reside within a single monospaced character. nil indicates the icon should remain unscaled (preserve its default size)." :foreground "Foreground face color to apply to the icon." :background "Background face color to apply to the icon.") :get-default-props (lambda () '(:scaling t)) :render (lambda () (when (hash-table-empty-p tui--all-the-icons-size-data) (tui-build-icon-dimension-data)) ;; TODO: improve on scaling algorithm ;; - avoid making tall icons (use fixed-width w<1 and h/w>1) (tui-let (&props icon-set icon-name scaling foreground background) (-let* (((scale-width . scale-height) (gethash (cons icon-set icon-name) tui--all-the-icons-size-data))) (tui-span :text-props `(font-lock-face ,(append (list :family (funcall (all-the-icons--family-name icon-set))) (when foreground (list :foreground foreground)) (when background (list :foreground background)) (when scaling (list :height (* (/ 1 scale-width) (if (eq scaling t) 1 scaling)))))) (assoc-default icon-name (funcall (all-the-icons--data-name icon-set)))))))) (provide 'tui-icon) ;;; tui-icon.el ends here ================================================ FILE: components/tui-line.el ================================================ ;;; tui-line.el --- Adds a newline after its content -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: (tui-define-component tui-line :documentation "Render with a newline after the child content." :render (lambda () (tui-let (&props children) (list children "\n")))) (provide 'tui-line) ;;; tui-line.el ends here ================================================ FILE: components/tui-link.el ================================================ ;;; tui-link.el --- A basic clickable link component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'dash) (require 'tui-defun) ;;; Code: (defun tui-link-keymap () "" (let ((map (make-sparse-keymap))) (define-key map "w" 'tui-link-copy-target) (define-key map [space] 'tui-link-follow-link) (define-key map [return] 'tui-link-follow-link) (define-key map [mouse-1] 'tui-link-follow-link-click) map)) (tui-defun-2 tui-link ((face 'button) target children &this this) "A basic link control. TARGET may be a Marker, function, or filename." (declare (wip TODO "handle file:/// targets")) (let* ((text-props (append `(keymap ,(tui-link-keymap) font-lock-ignore t tui-link-target ,target help-echo ,(prin1-to-string target)) (when face `(font-lock-face ,face face ,face))))) (tui-span :text-props-replace text-props :children (or children (format "%s" target))))) (defun tui-link-follow-link-click (event) "Handle click EVENT for following link." (interactive "e") (tui-link-follow-link (posn-point (event-end event)))) (defun tui-link-follow-link (&optional pos) "Follow link at POS or current point." (interactive) (unless pos (setq pos (point))) (-when-let* ((target (get-text-property pos 'tui-link-target))) (cond ((and (stringp target) (s-starts-with-p "chrome://" target)) (eww-browse-with-external-browser target)) ((and (stringp target) (s-starts-with-p "http" target)) (browse-url-xdg-open target)) ((and (stringp target) (f-exists-p target)) (find-file target)) ((markerp target) (switch-to-buffer (marker-buffer target)) (goto-char target) (when (eq major-mode 'org-mode) (org-show-entry))) ((functionp target) (funcall target)) ((and (listp target) (eq (car target) 'file)) (find-file (cdr target)))))) (defun tui-link-copy-target (&optional pos) "" (interactive) (unless pos (setq pos (point))) (let* ((url (get-text-property pos 'tui-link-target))) (kill-new url) (message "Copied <%s>!" url))) (provide 'tui-link) ;;; tui-link.el ends here ================================================ FILE: components/tui-ol.el ================================================ ;;; tui-ol.el --- HTML 'ol'-like component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: ;; TODO: additional capability with tui-li children? (tui-define-component tui-ol :documentation "Ordered list component" :render (lambda () (tui-let (&props children) (-map-indexed (lambda (index child) (tui-line (format "%d. " (+ 1 index)) child)) children)))) (provide 'tui-ol) ;;; tui-ol.el ends here ================================================ FILE: components/tui-prefix-lines.el ================================================ ;;; tui-prefix-lines.el --- Prefix content lines with a string ;;; Commentary: ;; (require 'tui-defun) ;;; Code: (tui-defun-2 tui-prefix-lines (prefix children) "Prefix all lines rendered by child elements with PREFIX." (tui-span :text-props `(line-prefix ,prefix wrap-prefix ,prefix) :children children)) (provide 'tui-prefix-lines) ;;; tui-prefix-lines.el ends here ================================================ FILE: components/tui-section.el ================================================ ;;; tui-section.el --- HTML 'section'-like element -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: (tui-define-component tui-section :documentation "HTML 'section'-like element. Includes a newline after the content." :render (lambda () (tui-let (&props children) (list children "\n")))) (provide 'tui-section) ;;; tui-section.el ends here ================================================ FILE: components/tui-span.el ================================================ ;;; tui-span.el --- HTML 'span'-like compnent -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-defun) ;;; Code: (tui-defun tui-span (children) "HTML 'span'-like compnent for grouping content." children) (provide 'tui-span) ;;; tui-span.el ends here ================================================ FILE: components/tui-spinner.el ================================================ ;;; tui-spinner.el --- Spinner component -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (tui-define-component tui-spinner :prop-documentation (:type "One of `spinner-types'" :fps "the number of desired frames per second" :delay "seconds to wait after starting the spinner before actually displaying it") :component-did-mount (lambda () (tui-run-with-timer component 1 1 t `(lambda () (tui-force-update ,component)))) :component-will-unmount (lambda () (tui-let (&state spinner) (spinner-stop spinner))) :get-initial-state (lambda () (require 'spinner) (tui-let (&props type fps delay) (let* ((spinner (make-spinner type nil fps delay))) (spinner-start spinner) (list :spinner spinner)))) :render (lambda () (tui-let (&state spinner) (spinner-print spinner)))) (provide 'tui-spinner) ;;; tui-spinner.el ends here ================================================ FILE: components/tui-timer.el ================================================ ;;; tui-demo-timer.el --- A basic timer -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (require 'tui-defun) (require 'tui-util) (tui-defun-2 tui-demo-timer (&state (start-time (current-time)) (timer (tui-run-with-timer component 1 1 t (lambda () (tui-force-update component))))) "A basic timer" (let* ((start-time-seconds (truncate (time-to-seconds start-time))) (current-time-seconds (truncate (time-to-seconds))) (elapsed-seconds (- current-time-seconds start-time-seconds)) (days (truncate (/ elapsed-seconds 86400))) (hours (truncate (/ (% elapsed-seconds 86400) 3600))) (minutes (truncate (/ (% elapsed-seconds 3600) 60))) (seconds (truncate (% elapsed-seconds 60)))) (tui-span (when (> days 0) (format "%d days " days)) (when (> hours 0) (format "%02d" hours)) (format "%02d:%02d" minutes seconds)))) (provide 'tui-timer) ;;; tui-demo-timer.el ends here ================================================ FILE: components/tui-ul.el ================================================ ;;; tui-ul.el --- HTML 'ul'-like component -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) ;;; Code: ;; TODO: additional capability with tui-li children? (tui-define-component tui-ul :documentation "Unordered list component" :render (lambda () (tui-let (&props children) (mapcar (lambda (child) (tui-line " • " child)) children)))) (provide 'tui-ul) ;;; tui-ul.el ends here ================================================ FILE: demo/tui-demo.el ================================================ ;;; tui-demo.el --- Demo-related logic -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'tui-components) (require 'tui-defun) ;;; Code: (define-derived-mode tui-demo-mode special-mode "Tui Demo" "Major mode for viewing tui component previews." (setq-local buffer-read-only t) (setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm) (tui-force-update (tui-root-node))))) (put 'tui-demo-mode 'mode-class 'special) (defun tui-show-component-demo (component demo-name) "Display demo content with DEMO-NAME for COMPONENT in a dedicated buffer." (interactive (let* ((component (tui-read-component-type))) (list component (completing-read "Demo: " (mapcar #'car (get component 'tui-demos)))))) (-when-let* ((demo-fn (assoc-default demo-name (get component 'tui-demos)))) (tui-show-demo-content (list (tui-heading (symbol-name component)) (tui-line demo-name) (funcall demo-fn))))) (defun tui-show-demo-content (content) "Display demo CONTENT in a dedicated buffer." (with-current-buffer (tui-render-with-buffer "*Tui Demo*" content) (tui-demo-mode))) (tui-define-component my/greeting :get-default-props (lambda () (list :name "World")) :render (lambda (this) (tui-let* ((&props name) this) (format "Hello, %s!\n" name)))) (defun my/basic-question () "What do you want to work on today?") (tui-define-component my/message :documentation "Message containing other components" :render (lambda () (tui-let (&props name) (list (my/greeting :name name) "\n------------\n" (my/basic-question) "\nmake " (tui-demo-basic-counter :start-value 3) " widgets!")))) ;; (defvar tui-test-keymap ;; (let ((map (make-sparse-keymap))) ;; (define-key map [down-mouse-1] #'tui-confirmation) ;; (define-key map [mouse-1] #'tui-confirmation) ;; map)) (tui-defun-2 tui-demo-basic-counter (start-value &this counter &state (or start-value 0)) "Basic counter control" (let* ((keymap (make-sparse-keymap))) (define-key keymap [down-mouse-1] (lambda () (interactive) (tui-set-state (-lambda ((&plist :count count)) (list :count (+ 1 count)))))) ;; (cl-flet ((incr-counter () (interactive) (tui-set-state `(:count ,(+ 1 count)))) ;; (decr-counter () (interactive) (tui-set-state `(:count ,(- count 1))))) (list count " > " (propertize "⏶" 'keymap keymap ;;`(keymap (down-mouse-1 . ,(lambda () (interactive) (tui-set-state 5))))) ;; `(keymap (down-mouse-1 . ,)) ) (propertize "⏷" ;; 'keymap ;; `(keymap (down-mouse-1 . ,#'decr-counter)) )))) (defmacro tui-define-demo (component description &rest body) "Define a demonstration of the use of COMPONENT. DESCRIPTION is used as a label and BODY returns the content to be rendered." (declare (indent 2)) `(let ((render-fn (lambda () ,@body)) (existing-demos (get ',component 'tui-demos))) (put ',component 'tui-demos (cons (cons ,description render-fn) (cl-remove ,description existing-demos :test #'equal :key #'car))))) ;; (tui-show-all-component-demos :: void) (defun tui-show-all-component-demos () "Display all defined component demos grouped by component in a dedicated buffer." (interactive) (tui-render-with-buffer "*Tui Demos (all)*" (mapcar (lambda (component) (tui-expander :header (tui-heading (symbol-name component)) :expanded-glyph "⏶" :collapsed-glyph "⏷" (tui-component-demos :component component))) (--filter (get it 'tui-demos) (tui-all-component-types))))) ;; (tui-show-component-demos String -> void) (defun tui-show-component-demos (component) "Show all defined demos for COMPONENT in a single buffer." (interactive (list (tui-read-component-type))) (tui-render-with-buffer (format "*Tui %s Demos*" component) (tui-component-demos :component (intern component)))) ;; (tui-component-demos :: Symbol -> List) (tui-define-component tui-component-demos :documentation "Render all defined demos for COMPONENT." :render (lambda () (tui-let (&props component) (-let* ((demos (get component 'tui-demos))) (if (not demos) (tui-div (format "No demos have been defined for %s. Define one using " component) (tui-link :target (-partial #'describe-function 'tui-define-demo) "tui-define-demo") ".") (mapcar (-lambda ((description . render-fn)) (tui-div (tui-heading description) (funcall render-fn))) demos)))))) (provide 'tui-demo) ;;; tui-demo.el ends here ================================================ FILE: demo/tui-tic-tac-toe.el ================================================ ;;; tui-tic-tac-toe.el --- A demo implementation of Tic-Tac-Toe -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'tui-components) (require 'tui-defun) ;; Design reference (for monospaced fonts) ;; ⌜ ⌝ ⌜ ⌝ ⌜ ⌝ ;; X O X Next player: X ;; ⌞ ⌟ ⌞ ⌟ ⌞ ⌟ ;; ⌜ ⌝ ⌜ ⌝ ⌜ ⌝ 1. Go to Game start ;; X O X 2. Go to Move #1 ;; ⌞ ⌟ ⌞ ⌟ ⌞ ⌟ 3. Go to Move #2 ;; ⌜ ⌝ ⌜ ⌝ ⌜ ⌝ ;; X O X ;; ⌞ ⌟ ⌞ ⌟ ⌞ ⌟ (tui-defun-2 tui-tic-tac-toe-cell (value i) "Build a tic-tac-toe cell containing VALUE for cell I with appropriate absolute x,y positioning." (tui-button :max-width 3 :max-height 3 :face nil :action `(lambda (event) (interactive "e") (-when-let* ((game (tui-get-element-at (posn-point (event-start event)) 'tui-tic-tac-toe-game))) (tui-tic-tac-toe--handle-click game ,i))) (concat "⌜ ⌝\n" (format " %s \n" (or value " ")) "⌞ ⌟\n"))) (tui-defun-2 tui-tic-tac-toe-board (squares &this this) "Render Tic-Tac-Toe board." (tui-absolute-container :children (cl-loop for i from 0 to 8 collect (tui-tic-tac-toe-cell :x (* (% i 3) 4) :y (* (/ i 3) 3) :value (nth i squares) :i i)))) (tui-define-component tui-tic-tac-toe-game :documentation "A demo implementation of Tic-Tac-Toe. Basedon on Dan Abramov's Tic-Tac-Toe tutorial for React at https://codepen.io/gaearon/pen/gWWZgR?editors=0010." :state-documentation (:history "Representation of the current board state and the board state of all previous turns in the current game." :x-is-next "Truthy if 'X' is the next player to play.") :get-initial-state (lambda (_) (list :history (list (make-list 9 nil)) :x-is-next t)) :render (lambda (this) (tui-let (&state history x-is-next) (let* ((step-number (- (length history) 1)) (current (nth step-number history)) (winner (tui-tic-tac-toe-calculate-winner current))) (tui-absolute-container (tui-tic-tac-toe-board :x 2 :y 3 :width 11 :height 9 :squares (copy-list current)) (tui-div :x 17 :y 2 :width 20 :height 12 (if winner (tui-div (concat "Winner: " winner)) (tui-div (concat "Next player: " (if x-is-next "X" "O") " "))) "\n" (tui-ol :children (-map-indexed (-lambda (move squares) (let* ((desc (if (> move 0) (format "Go to move #%d" move) "Go to game start"))) (tui-button :action `(lambda (event) (interactive "e") (-when-let* ((game (tui-get-element-at (posn-point (event-start event)) 'tui-tic-tac-toe-game))) (tui-tic-tac-toe-jump-to game ,move))) desc))) history)))))))) (defun tui-tic-tac-toe--handle-click (game i) "Handle mouse click for GAME board cell I." (let* ((state (tui--get-state game)) (history (plist-get state :history)) (current (-last-item history)) (squares (cl-copy-list current))) (unless (or (tui-tic-tac-toe-calculate-winner squares) (nth i squares)) (setf (nth i squares) (if (plist-get state :x-is-next) "X" "O")) (tui--save-point-row-column (tui--set-state game (list :history (append history (list squares)) :x-is-next (not (plist-get state :x-is-next)))))))) (defun tui-tic-tac-toe-jump-to (game turn-number) "Roll back GAME state to TURN-NUMBER." (let* ((state (cl-copy-list (tui--get-state game))) (history (plist-get state :history))) (tui--save-point-row-column (tui--set-state game (list :history (cl-subseq history 0 (+ 1 turn-number)) :x-is-next (= (% turn-number 2) 0)))))) ;;;###autoload (defun tui-tic-tac-toe-insert-game () "Render Tic-Tac-Toe game at point." (interactive) (tui-render-element (tui-tic-tac-toe-game))) ;;;###autoload (defun tui-play-tic-tac-toe () "Play a game of Tic Tac Toe." (interactive) (let* ((buffer (get-buffer-create "*Tic Tac Toe*"))) (tui-render-element (tui-buffer :buffer buffer (tui-tic-tac-toe-game))) (switch-to-buffer buffer))) (defun tui-tic-tac-toe-calculate-winner (squares) "Calculate whether the state of SQUARES yields a winner." (let ((lines '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6)))) (cl-loop for (a b c) in lines if (and (nth a squares) (equal (nth a squares) (nth b squares)) (equal (nth a squares) (nth c squares))) return (nth a squares)))) (provide 'tui-tic-tac-toe) ;;; tui-tic-tac-toe.el ends here ================================================ FILE: layout/tui-absolute-container.el ================================================ ;;; tui-absolute-container.el --- Container for absolute positioning of contents -*- lexical-binding: t; -*- ;;; Commentary: ;; ;; TODO: eliminate artist dependency (require 'artist) (require 'tui-core) (require 'tui-canvas "components/tui-canvas.el") (require 'tui-buffer "components/tui-buffer.el") (require 'subr-x) ;;; Code: (tui-define-component tui-absolute-container ;; TODO: support labels for indirect buffers to help with development :documentation "A layout component to enable absolute positioning of children within this container. Child elements are rendered using indirect buffers. Child elements will be positioned by properties on the child elements themselves: :x - Distance from the beginning of the line for positioning of content (defaults to 0). :y - Distance from the top of the buffer for positioning content (defaults to 0). :max-width - Maximum width of the copied content. :max-height - Maximum height of the copied content." :get-initial-state (lambda (this) (list :canvas-ref (tui-create-ref) ;; :buffer (get-buffer-create (format " *tui-absolute-container-%d*" (tui-node-id component))) :child-buffers (make-hash-table :test #'equal))) :render (lambda (this) (tui-let (&props children &state canvas-content canvas-ref child-buffers) (tui-div (tui-span :children (-map-indexed (lambda (index child) (tui-buffer :ref `(lambda (ref) (puthash ,index ref ,child-buffers)) :index index child)) children)) (tui-canvas :ref canvas-ref)))) :component-did-mount (lambda (this) (tui-absolute-container--update component)) :component-did-update (lambda (this next-props next-state) ;; (when (or (not (eq next-props (tui-get-props))) ;; (not (tui--plist-equal (tui--plist-delete next-state :canvas-content) (tui--plist-delete (tui-get-state) :canvas-content)))) ;; (tui-absolute-container--update this)) )) (defun tui-absolute-container--update-parent (&rest ignore) "Helper to update the parent container." (message (format "BUFFER-UPDATED EVENT (%s)" (buffer-name (current-buffer)))) (-when-let* ((container (tui-parent tui-buffer--ref 'tui-absolute-container))) ;;(message (format "BUFFER-UPDATED EVENT %d (%s)" (tui-node-id container) (buffer-name (current-buffer)))) ;;(display-warning 'tui-absolute-container (format "BUFFER-UPDATED EVENT %d (%s)" (tui-node-id container) (buffer-name (current-buffer))) :debug tui-log-buffer-name) (tui-absolute-container--update container))) ;; (defun tui-absolute--copy-contents (component) ;; "Copy string content to the dependent buffer location represented by COMPONENT." ;; (-let* ((props (tui--get-props component)) ;; (parent (tui-parent component)) ;; (width (plist-get props :width)) ;; (height (plist-get props :height)) ;; (x (plist-get props :x)) ;; (y (plist-get props :y)) ;; (children (tui-child-nodes component))) ;; (when (and (tui-mounted-p parent) ;; (-every-p ;; #'tui-mounted-p ;; children)) ;; (save-current-buffer ;; (tui--save-point-row-column ;; (tui--goto (tui-start (cl-first children))) ;; (let* ((buffer-contents (buffer-substring (point-min) (point-max))) ;; (content (with-temp-buffer ;; (insert buffer-contents) ;; (artist-copy-generic 0 0 (- width 1) (- height 1))))) ;; (when parent ;; (tui--goto (tui-start parent))) ;; (tui-absolute--paste content x y width height))))))) (cl-defmethod tui-absolute-container--update ((container tui-absolute-container)) "Re-render CANVAS - replacing its content with its separately rendered children." ;; CLEANUP: split this function (message "UPDATE %S (%d)" (tui--type container) (tui-node-id container)) (-let* ((props (tui--get-props container)) (children (plist-get props :children)) (state (tui--get-state container)) (canvas (tui-ref-element (plist-get state :canvas-ref))) (child-buffers (plist-get state :child-buffers))) (tui-canvas-erase canvas t) ;; (let* ((keyed-children (-map-indexed ;; (lambda (index child) ;; (let* ((key (or (when (tui-node-p child) ;; (plist-get (tui--get-props child) :key)) ;; index))) ;; (cons key child))) ;; children))) (mapc (lambda (child-buffer) (-let* ((child-content (tui-buffer--get-content child-buffer)) ((child) (plist-get (tui--get-props child-buffer) :children));; (child-buffer (gethash key child-buffers)) ((&plist :x x :y y) (tui--get-props child))) ;; (if child-buffer ;; (tui--set-props child-buffer (list :children (list child))) ;; (setq child-buffer (tui-buffer ;; :buffer (format " *tui-absolute-container-%d-%s*" (tui-node-id container) (tui--new-id)) ;; child)) ;; (puthash key child-buffer child-buffers) ;; (tui-render-element child-buffer)) (tui-canvas--paste-content-at canvas child-content (or x 0) (or y 0) t))) (-sort (lambda (child-a child-b) (< (plist-get (tui--get-props child-a) :index) (plist-get (tui--get-props child-b) :index))) (hash-table-values child-buffers))) (tui-force-update canvas))) ;; (defun tui-absolute--paste (content x y width height) ;; "Paste CONTENT at position X,Y filling WIDTH and HEIGHT." ;; (dotimes (line height) ;; (let ((string (pop content))) ;; (artist-move-to-xy x (+ y line)) ;; (delete-region (point) (min (+ (point) width) ;; (save-excursion (end-of-line) ;; (point)))) ;; (when string ;; (insert string))))) (defun tui-absolute-container--needing-update () "" (-let* ((-compare-fn #'eq) (containers (-uniq (-non-nil (mapcar (lambda (buffer) (tui--mark-buffer-clean buffer) (-when-let* ((buffer-element (buffer-local-value 'tui-buffer--ref buffer))) (tui-parent buffer-element 'tui-absolute-container))) (tui--updated-buffers))))) (containers-by-height (-sort (-lambda ((height-a) (height-b)) (> height-a height-b)) (mapcar (lambda (container) (cons (tui--node-height container) container)) containers)))) (mapcar #'cdr containers-by-height))) (defun tui-absolute-container--update-all () "Update all indirect ‘tui-absolute-container’ elements." (let* ((inhibit-modification-hooks t) (containers (tui-absolute-container--needing-update))) (when containers (display-warning 'tui-absolute-container (format "UPDATING %S" (mapcar #'tui-node-id containers)) :debug tui-log-buffer-name)) (mapc #'tui-absolute-container--update containers))) (add-hook 'tui-update-hook #'tui-absolute-container--update-all) (defmacro tui--save-point-row-column (&rest body) "Utility macro to restore point based on the row and column." (let ((row-num-var (make-symbol "row-num")) (col-num-var (make-symbol "col-num"))) `(let* ((,row-num-var (line-number-at-pos)) (,col-num-var (current-column))) (prog1 (progn ,@body) (goto-char (point-min)) (forward-line (1- ,row-num-var)) (move-to-column ,col-num-var))))) (cl-defmethod tui--update ((this tui-absolute-container) &optional next-props next-state force) "Wrap the update lifecycle method to preserve position based on the row and column of the point rather than using a marker." (tui--save-point-row-column (cl-call-next-method this next-props next-state force))) (defun tui--show-indirect-buffer (element) "Show indirect buffer in a separate window." (interactive (list (tui-get-element-at (point) 'tui-absolute-container))) (-when-let* ((buffer-name (plist-get (tui--get-state element) :buffer-ref))) (switch-to-buffer-other-window buffer-name))) (defun tui--show-all-indirect-buffers () "Show all indirect buffers for the current content tree." (interactive) (tui-map-subtree (lambda (element) (when (tui-buffer-p element) (tui--show-indirect-buffer element))) (tui-root-node))) ;; (defun tui-absolute--clean-up-indirect-buffers () ;; "" ;; (interactive) ;; (kill-matching-buffers "\\ \\*Tui-")) (provide 'tui-absolute-container) ;;; tui-absolute-container.el ends here ================================================ FILE: snippets/emacs-lisp-mode/keyword-component-did-mount ================================================ # -*- mode: snippet -*- # name: keyword-component-did-mount # key: :cdm # -- :component-did-mount (lambda () $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-component-did-update ================================================ # -*- mode: snippet -*- # name: keyword-component-did-update # key: :cdu # -- :component-did-update (lambda (next-props next-state) $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-component-will-unmount ================================================ # -*- mode: snippet -*- # name: keyword-component-will-unmount # key: :cwun # -- :component-will-unmount (lambda () $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-get-default-props ================================================ # -*- mode: snippet -*- # name: keyword-get-default-props # key: :gdp # -- :get-default-props (lambda () $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-get-derived-state-from-props ================================================ # -*- mode: snippet -*- # name: keyword-get-derived-state-from-props # key: :gds # -- :get-derived-state-from-props (lambda (props state) $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-get-initial-state ================================================ # -*- mode: snippet -*- # name: keyword-get-initial-state # key: :gis # -- :get-initial-state (lambda () $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-render ================================================ # -*- mode: snippet -*- # name: keyword-render # key: :r # -- :render (lambda () $0) ================================================ FILE: snippets/emacs-lisp-mode/keyword-should-component-update ================================================ # -*- mode: snippet -*- # name: keyword-should-component-update # key: :scu # -- :should-component-update (lambda (next-props next-state) $0) ================================================ FILE: snippets/emacs-lisp-mode/tui-define-component ================================================ #name: tui-define-component #key: tuic # -- (tui-define-component ${1:component} :documentation "" :prop-documentation () :render (lambda () $0)) ================================================ FILE: snippets/emacs-lisp-mode/tui-get-props ================================================ #name: tui-get-props #key: prop # -- (tui-get-props) ================================================ FILE: test/components/tui-buffer-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-buffer") ================================================ FILE: test/components/tui-div-test.el ================================================ (require 'buttercup) (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-div "components/tui-div.el") (describe "tui-div" (it "renders w/leading and following newlines" (expect (tui-render-to-string (tui-div "foo")) :to-equal "\nfoo\n"))) ================================================ FILE: test/components/tui-expander-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 's) (require 'tui-buffer "components/tui-buffer.el") (require 'tui-expander "components/tui-expander.el") (describe "tui-expander" (xit "is initially expanded by default" (let ((expander (tui-expander :header "header" :children "content"))) (tui-with-rendered-element expander (expect (s-contains-p "header" (buffer-string))) (expect (s-contains-p "content" (buffer-string)))))) (xit "hides content when collapsed" (let ((expander (tui-expander :header "header" :children "content"))) (tui-with-rendered-element expander (tui-expander--collapse expander) ;;(buffer-substring (point-min) (point-max)))) (expect (s-contains-p "header" (buffer-string))) (expect (not (s-contains-p "content" (buffer-string))))))) (xit "has idempotent expand and collapse functions" (let ((expander (tui-expander :header "header" :children "content"))) (tui-with-rendered-element expander (expect (s-contains-p "content" (buffer-string))) (tui-expander--collapse expander) (expect (not (s-contains-p "content" (buffer-string)))) (tui-expander--collapse expander) (expect (not (s-contains-p "content" (buffer-string)))) (tui-expander--expand expander) (expect (s-contains-p "content" (buffer-string))) (tui-expander--expand expander) (expect (s-contains-p "content" (buffer-string)))))) (xit "toggles expansion" (tui-with-rendered-element (tui-expander :header "header" :children "content") (expect (s-contains-p "content" (buffer-string))) (tui-expander-toggle-expansion tui-element) (expect (not (s-contains-p "content" (buffer-string)))) (tui-expander-toggle-expansion tui-element) (expect (s-contains-p "content" (buffer-string)))))) (describe "nested expanders" (xit "inner expander expands and collapses independently of outer expander." (let* ((inner-expander (tui-expander :header (tui-line "inner-header") :children (tui-line "inner-content"))) (outer-expander (tui-expander :header (tui-line "outer-header") :children (list (tui-line "outer-content") inner-expander)))) (tui-with-rendered-element outer-expander (expect (s-contains-p "outer-header" (buffer-string))) (expect (s-contains-p "outer-content" (buffer-string))) (expect (s-contains-p "inner-header" (buffer-string))) (expect (s-contains-p "inner-content" (buffer-string))) (tui-expander--collapse inner-expander) (expect (s-contains-p "outer-header" (buffer-string))) (expect (s-contains-p "outer-content" (buffer-string))) (expect (s-contains-p "inner-header" (buffer-string))) (expect (not (s-contains-p "inner-content" (buffer-string)))) (tui-expander--expand inner-expander) (expect (s-contains-p "outer-header" (buffer-string))) (expect (s-contains-p "outer-content" (buffer-string))) (expect (s-contains-p "inner-header" (buffer-string))) (expect (s-contains-p "inner-content" (buffer-string))) ;;(tui-expander--collapse inner-expander) (tui-expander--collapse outer-expander) (expect (s-contains-p "outer-header" (buffer-string))) (expect (not (s-contains-p "outer-content" (buffer-string)))) (expect (not (s-contains-p "inner-header" (buffer-string)))) (expect (not (s-contains-p "inner-content" (buffer-string)))) (tui-expander--collapse inner-expander) (expect (s-contains-p "outer-header" (buffer-string))) (expect (not (s-contains-p "outer-content" (buffer-string)))) (expect (not (s-contains-p "inner-header" (buffer-string)))) (expect (not (s-contains-p "inner-content" (buffer-string)))) (tui-expander--expand outer-expander) (expect (s-contains-p "outer-header" (buffer-string))) (expect (s-contains-p "outer-content" (buffer-string))) (expect (s-contains-p "inner-header" (buffer-string))) (expect (not (s-contains-p "inner-content" (buffer-string)))) ;; (tui-expander--expand outer-expander) ;; (expect (s-contains-p "outer-header" (buffer-string))) ;; (expect (s-contains-p "outer-content" (buffer-string))) ;; (expect (s-contains-p "inner-header" (buffer-string))) ;; (expect (s-contains-p "inner-content" (buffer-string))) ))) (xit "should preserve child elements across collapse/expand") (xit "should preserve the expansion state of a nested expander")) ================================================ FILE: test/components/tui-fixed-width-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-fixed-width "components/tui-fixed-width.el") (describe "tui-fixed-width" (describe "character-width specification" (it "pads a short element to a longer fixed width" (tui-with-rendered-element (tui-fixed-width :width '10 "Hello!") (expect (- (point-max) (point-min)) :to-equal 10))) (it "renders an element with the samed fixed width" (expect (tui-with-rendered-element (tui-fixed-width :width 13 "Hello, world!") (- (point-max) (point-min))) :to-equal 13)) (it "truncates a long element to a shorter fixed width" (expect (tui-with-rendered-element (tui-fixed-width :width 3 "Hey there world!") (- (point-max) (point-min))) :to-equal 3))) (describe "precise pixel specification" (xit "builds the desired width for content that includes a symbol" (expect (tui-with-rendered-element (tui-fixed-width :width '(20) (list #("" 0 1 (font-lock-ignore t display (raise -0.24) face (:family "github-octicons" :height 1.2))) " foo bar baz")) (tui-segment-pixel-width (point-min) (point-max))) :to-equal 20))) (describe "nested fixed-width elements" (describe "...with children shorter than the parent" (expect (tui-with-rendered-element (tui-fixed-width :width 20 (tui-fixed-width :width 5 "foo") (tui-fixed-width :width 5 "bar")) (- (point-max) (point-min))) :to-equal 20)) (describe "...with children longer than the parent" (expect (tui-with-rendered-element (tui-fixed-width :width 10 (tui-fixed-width :width 10 "foo") (tui-fixed-width :width 10 "bar")) (- (point-max) (point-min))) :to-equal 10))) (describe "searching hidden values") (describe "customizable ellipsis behavior") (describe "expand/collapse (disabling truncation)") (describe "see full value on hover")) ;; (tui-render ;; (list ;; (tui-fixed-width ;; :width '(54) ;; "wooooooooooooooooooooooooo!") ;; "|" ;; (tui-fixed-width ;; :width 10 ;; :children "foo") ;; "|" ;; (tui-fixed-width ;; :width 10 ;; :children "blooh!") ;; "|" ;; (tui-fixed-width ;; :width 10 ;; :children "bar"))) ================================================ FILE: test/components/tui-heading-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-header" (describe "heading that is a link" ;; TODO: Check browser behavior ;; link around heading ;; heading around link )) ================================================ FILE: test/components/tui-link-test.el ================================================ (require 'buttercup) (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-link "components/tui-link.el") (describe "tui-link" (it "supports markers as targets") (it "supports file paths as targets") (it "supports URL's as targets")) ================================================ FILE: test/components/tui-overlay-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-overlay") ================================================ FILE: test/components/tui-popup-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-popup" (it "stacks popups") (it "inherits special-mode")) ================================================ FILE: test/components/tui-prefix-lines-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-prefix-lines) ;; (tui-render ;; (tui-prefix-lines ;; :prefix ">" ;; :content ;; (list ;; (tui-line "foo") ;; (tui-line " bar") ;; (tui-line " baz")))) ================================================ FILE: test/components/tui-sparkline-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") ================================================ FILE: test/components/tui-tree-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-tree") ================================================ FILE: test/layout/tui-absolute-container-test.el ================================================ (require 'tui-absolute-container "layout/tui-absolute-container.el") (require 'buttercup) (require 'tui-buttercup-matchers "test/tui-buttercup-matchers.el") (describe "tui-absolute-container" (it "renders an blank component" (tui-with-rendered-element (tui-absolute-container) (expect (buffer-string) :to-equal "\n\n"))) (it "renders components horizontally" (let* ((container (tui-absolute-container (tui-span :x 1 :y 0 "foo") (tui-span :x 7 :y 0 "bar") (tui-span :x 14 :y 0 "baz")))) (expect (tui-render-to-string container) :to-equal "\n foo bar baz\n"))) (it "renders components vertically" (let* ((container (tui-absolute-container (tui-span :x 0 :y 0 "foo") (tui-span :x 0 :y 2 "bar") (tui-span :x 0 :y 5 "baz")))) (expect (tui-render-to-string container) :to-equal "\nfoo\n\nbar\n\n\nbaz\n"))) (it "renders multiline components horizontally" (let* ((rectangle (s-join "\n" (list "+---+" "| |" "+---+"))) (container (tui-absolute-container (tui-span :x 0 :y 0 rectangle) (tui-span :x 6 :y 0 rectangle)))) (expect (tui-render-to-string container) :to-equal (concat "\n" (s-join "\n" (list "+---+ +---+" "| | | |" "+---+ +---+")) "\n")))) (it "renders overlapping components" (let* ((rectangle (s-join "\n" (list "+---+" "| |" "+---+"))) (container (tui-absolute-container (tui-span :x 0 :y 0 rectangle) (tui-span :x 2 :y 1 rectangle)))) (expect (tui-render-to-string container) :to-equal (concat "\n" (s-join "\n" (list "+---+" "| +---+" "+-| |" " +---+")) "\n")))) (it "can be nested within other tui-absolute-container elements" (expect (tui-render-to-string (tui-absolute-container (tui-span :x 2 :y 2 " " (tui-absolute-container (tui-span :x 1 :y 1 "x"))))) :to-equal " x ")) (it "updates to reflect nested tui-absolute-container elements" )) ================================================ FILE: test/tui-buttercup-matchers.el ================================================ (buttercup-define-matcher :tui/to-equal (a b) (cl-destructuring-bind ((a-expr . a) (b-expr . b)) (mapcar #'buttercup--expr-and-value (list a b)) (if (equal a b) t (cons nil (format "Expected `%s' to equal:\n====\n%s\n====\nBut received:\n====\n%s\n====\n" a-expr b a))))) (provide 'tui-buttercup-matchers) ================================================ FILE: test/tui-core-test.el ================================================ ;; -*- lexical-binding: t; -*- (require 'tui-test-helper "test/tui-test-helper.el") (require 'buttercup) (require 's) (require 'tui) ;; CLEANUP: improve testing focus (describe "tui-define-component" (it "accepts a documentation string" (expect (tui-define-component tui-test-component-a :documentation "Documentation!" :render (lambda () nil)))) (it "accepts a prop-documentation string" (expect (tui-define-component tui-test-component-b :prop-documentation "Property documentation!" :render (lambda () nil)))) (it "requires a render method" (expect (tui-define-component tui-test-component-c :render (lambda () nil))) ;; TODO: Raise an error when no method is supplied? (or is it not required?) ;; (expect (tui-define-component tui-test-component-c)) )) (describe "Re-renders" (it "should preserve point when possible") (it "should preserve mark whenever possible") (it "should preserve region whenever possible")) (describe "tui-component" (describe "lifecycle" (describe "lifecycle methods" (describe "tui-get-default-props" (it "gets called before tui-get-initial-state")) (describe "tui-get-initial-state" (it "is reflected in the initial component state")) (describe "tui--mount" (it "calls an overridden tui--mount when defined")) (describe "tui-component-did-mount" (it "is called on mount") (it "component is marked as mounted already") (it "is called with a dynamically-scoped `component' reference" (cl-flet ((my/test-component-did-mount () (expect (tui--type component) :to-equal 'my/test-component-did-mount))) (tui-define-component my/test-component-did-mount-component :component-did-mount 'my/test-component-did-mount :render (lambda () "Test!")) (spy-on 'my/test-component-did-mount) (tui-with-rendered-element (my/test-component-did-mount-component) (expect 'my/test-component-did-mount :to-have-been-called-times 1))))) (describe "tui-get-derived-state-from-props" :var (my/get-derived-state-from-props my/test-component) (before-each (setf (symbol-function 'my/get-derived-state-from-props) (lambda (_ props state) (let* ((a (plist-get props :a)) (b (plist-get state :b))) (when (and a b) (list :c (* a b)))))) (tui-define-component my/test-component :get-default-props (lambda () (list :a 7)) :get-initial-state (lambda () (list :b 6)) :get-derived-state-from-props #'my/get-derived-state-from-props :render (lambda () "test"))) (after-each (tui-unintern 'my/test-component)) (it "receives component props and state" (spy-on 'my/get-derived-state-from-props) (tui-with-rendered-element (my/test-component) ;; CLEANUP: Check using something like plist-contains (-let* ((call-args (spy-calls-args-for 'my/get-derived-state-from-props 0)) ((_ (&plist :a a) (&plist :b b)) call-args)) (expect call-args) (expect a :to-be 7) (expect b :to-be 6)))) (it "has its return value merged into state" (tui-with-rendered-element (my/test-component) (expect (plist-get (tui--get-state tui-element) :c) :to-be 42))) (it "is called before the initial render call" (let* (render-called-p get-derived-state-called-first-p) (cl-defmethod tui-render ((component my/test-component)) (setq render-called-p t) (cl-call-next-method)) (spy-on 'my/get-derived-state-from-props :and-call-fake (lambda (_ props state) (setq get-derived-state-called-first-p (not render-called-p)))) (tui-with-rendered-element (my/test-component) (expect get-derived-state-called-first-p :to-be t)))) (it "is called when component properties are updated" (tui-with-rendered-element (my/test-component) (spy-on 'my/get-derived-state-from-props) (expect 'my/get-derived-state-from-props :not :to-have-been-called) (tui--set-props tui-element '(:a 70)) (expect 'my/get-derived-state-from-props :to-have-been-called))) (it "is not called when component state is updated" (tui-with-rendered-element (my/test-component) (spy-on 'my/get-derived-state-from-props) (tui--set-state tui-element '(:b 0)) (expect 'my/get-derived-state-from-props :not :to-have-been-called))) (describe "tui-should-component-update" (it "inhibits an update with a nil return value") (it "is called following a prop update") (it "is called following a state update")) (describe "tui-component-did-update") (describe "tui-will-unmount" (it "is called when a component is removed"))) (describe "unmounting" (it "all elements get unmounted when buffer is about to be destroyed") (it "unmounting can be skipped on buffer destruction" ;; TODO: configuration value )))) (describe "ref callback" :var (my/ref-callback my/test-component component-did-mount-called-p) (before-each (setq component-did-mount-called-p nil) (setf (symbol-function 'my/ref-callback) (lambda (component) nil)) (tui-define-component my/test-component :component-did-mount (lambda () (setq component-did-mount-called-p t)) :render (lambda () "test"))) (after-each (tui-unintern 'my/test-component)) (it "is called once before the :component-did-mount method" (let* (ref-callback-called-first-p) (spy-on 'my/ref-callback :and-call-fake (lambda (component) (setq ref-callback-called-first-p (not component-did-mount-called-p)) nil)) (tui-with-rendered-element (my/test-component :ref #'my/ref-callback) (expect component-did-mount-called-p) (expect ref-callback-called-first-p)))) (xit "is called with nil when unmounting" (spy-on 'my/ref-callback) (tui-with-rendered-element (my/test-component :ref #'my/ref-callback) (spy-calls-reset 'my/ref-callback)) (expect 'my/ref-callback :to-have-been-called-with nil)) (it "is called with nil before update when :ref argument is changed"))) (describe "tui-element" (it "leaves adjacent non- comp content intact" (with-temp-buffer (insert "foobaz") (let ((element (tui-render-element "bar" 4))) (expect (buffer-string) :to-equal "foobarbaz") (tui-remove element) (expect (buffer-string) :to-equal "foobaz")))) (it "stores output segment on render" (tui-with-rendered-element "Hello world!" (-let* (((start . end) (tui-segment tui-element))) (expect (markerp start)) (expect (markerp end))))) (describe "rendering targets" (it "is able to render element at a provided point" (with-temp-buffer (insert "foobaz") (tui-render-element "bar" 4) (expect (buffer-string) :to-equal "foobarbaz"))) (it "signals an error when a rendering target is not a node, but within an existing content tree" ;; TODO: implement ) (it "can render an element within an existing element" (let ((span (tui-span "foo"))) (tui-with-rendered-element span (tui-render-element "bar" span) (expect (buffer-string) :to-equal "foobar")))))) (describe "text properties" (it "basic text properties are applied" (tui-with-rendered-element (tui-span :text-props '(foo "bar") "woo") (expect (get-text-property 1 'foo) :to-equal "bar"))) (it "text properties are updated even if they are the change between renders") (describe "tui-put-text-properties" (describe "'replace")) (describe "text property inheritance")) (describe "empty elements") (describe "visibility" (describe "hiding elements" (it "hides a basic element" (tui-with-rendered-element (tui-span "foo") (tui-hide-element tui-element) (expect (buffer-string) :to-equal ""))) (it "can hide a basic compontent" (tui-with-rendered-element (tui-span "foo") (tui-hide-element tui-element) (expect (not (s-contains-p "foo" (buffer-string)))))) (it "hides an entire element subtree") (it "only hides subtree of the target element" (let ((preceding-content (tui-line "Preceding content")) (hide-me (tui-span "Hide me!")) (following-content "(but not me!)")) (tui-with-rendered-element (tui-span preceding-content hide-me following-content) (tui-hide-element hide-me) (expect (tui-invisible-p hide-me)) (expect (not (tui-invisible-p preceding-content))) (expect (not (tui-invisible-p following-content))) (expect (not (tui-invisible-p tui-element))) (expect (s-contains-p "Preceding content" (buffer-string))) (expect (not (s-contains-p "Hide me!" (buffer-string)))) (expect (s-contains-p "(but not me!)" (buffer-string)))))) (it "is idempotent (hiding a hidden element does nothing)" )) (describe ":invisible elements" (it "is not rendered when :invisible is truthy" (tui-with-rendered-element (tui-span :invisible t :children "foo") (expect (buffer-string) :to-equal "")))) (it "hides only invisibile elements when intermixed with visible elements") (it "hides a previously visible element when :invisible is changed to t") (it "does not unmount element when :invisible property is changed to t") (it "prop-controlled visibilities are unchangable?")) (describe "content tree operations" (describe "tui-insert-node" (it "can insert an element into an empty list" (tui-with-rendered-element (tui-span) (tui-insert-node (tui-span "foo") tui-element 0) (expect (buffer-string) :to-equal "foo"))) (it "can insert an element at the beginning of a list" (let ((bar (tui--normalize-node "bar"))) (tui-with-rendered-element (tui-span bar) (tui-insert-node (tui-span "foo") tui-element 0) (expect (buffer-substring (point-min) (point-max)) :to-equal "foobar") (expect (tui-node-relative-index bar) :to-be 1)))) (it "can insert an element at the end of a list" (let ((foo (tui--normalize-node "foo"))) (tui-with-rendered-element (tui-span foo) (tui-insert-node (tui-span "bar") tui-element 1) (expect (buffer-substring (point-min) (point-max)) :to-equal "foobar") (expect (tui-node-relative-index foo) :to-be 0)))) (it "can insert an element in the middle of a list" (let* ((foo (tui--normalize-node "foo")) (bar (tui-span "bar")) (baz (tui--normalize-node "baz"))) (tui-with-rendered-element (tui-span foo baz) (tui-insert-node bar tui-element 1) (expect (buffer-substring (point-min) (point-max)) :to-equal "foobarbaz") (expect (tui-node-relative-index foo) :to-be 0) (expect (tui-node-relative-index bar) :to-be 1) (expect (tui-node-relative-index baz) :to-be 2)))) (it "can insert an element already in the list" (let ((foo (tui--normalize-node "foo")) (bar (tui--normalize-node "bar")) (baz (tui--normalize-node "baz")) (-compare-fn #'eq)) (tui-with-rendered-element (tui-span foo bar baz) (tui-insert-node baz tui-element 0) (expect (buffer-string) :to-equal "bazfoobar") (expect (tui-node-relative-index baz) :to-be 0) (expect (tui-node-relative-index foo) :to-be 1) (expect (tui-node-relative-index bar) :to-be 2)))) (it "can insert an element already in the list at the same position" (let ((foo (tui--normalize-node "foo")) (bar (tui--normalize-node "bar")) (baz (tui--normalize-node "baz"))) (tui-with-rendered-element (tui-span foo bar baz) (tui-insert-node bar tui-element 1) (expect (tui-valid-element-p tui-element)) (expect (buffer-string) :to-equal "foobarbaz")))) (it "can reinsert the sole child of an element at the same position" (let ((foo (tui--normalize-node "foo"))) (tui-with-rendered-element (tui-span foo) (tui-insert-node foo tui-element 0) (expect (tui-valid-element-p tui-element)) (expect (buffer-string) :to-equal "foo")))) (it "can reinsert the sole child of an element into another element" (let* ((foo (tui--normalize-node "foo")) (bar (tui-span foo)) (baz (tui-span))) (tui-with-rendered-element (tui-span bar "-" baz) (tui-insert-node foo baz 0) (expect (tui-valid-element-p tui-element)) (expect (buffer-string) :to-equal "-foo")))))) (describe "tui-lowest-common-ancestor" (it "identifies shared parent" (let* ((a (tui-span "A")) (b (tui-span "B")) (c (tui-span "C" a b))) (tui-with-rendered-element c (expect (tui-lowest-common-ancestor a b) :to-be c))))) (describe "tui-remove" (it "throws an error when target node is not mounted") (it "can remove the first child of an element" (let ((a (tui--normalize-node "a")) (b (tui--normalize-node "b")) (c (tui--normalize-node "c"))) (tui-with-rendered-element (tui-span a b c) (tui-remove a) (expect (tui-node-relative-index b) :to-be 0) (expect (tui-node-relative-index c) :to-be 1)))) (it "can remove the middle of an element" (let ((a (tui--normalize-node "a")) (b (tui--normalize-node "b")) (c (tui--normalize-node "c"))) (tui-with-rendered-element (tui-span a b c) (tui-remove b) (expect (tui-node-relative-index a) :to-be 0) (expect (tui-node-relative-index c) :to-be 1)))) (it "can remove end last child of an element" (let ((a (tui--normalize-node "a")) (b (tui--normalize-node "b")) (c (tui--normalize-node "c"))) (tui-with-rendered-element (tui-span a b c) (tui-remove c) (expect (tui-node-relative-index a) :to-be 0) (expect (tui-node-relative-index b) :to-be 1)))) (it "can remove the only child of an element" (let ((a (tui--normalize-node "a"))) (tui-with-rendered-element (tui-span a) (tui-remove a) (expect (tui-child-nodes tui-element) :to-be nil))))) (describe "tui-force-update" (it "re-renders target component" (let* ((component-b (tui-span "Blah")) (component-a (tui-span component-b))) (spy-on 'tui-render :and-call-through) (tui-with-rendered-element component-a (expect 'tui-render :to-have-been-called-with component-a) (spy-calls-reset 'tui-render) (tui-force-update component-a) (expect 'tui-render :to-have-been-called-with component-a)))) (it "calls should-component-update on all children")) (describe "core utility functions" (describe "tui--set-props" (it "preserves existing properties" (tui-define-component tui-set-props-test-component :get-default-props (lambda () (list :a 1234)) :render (lambda () "test")) (let* ((test-component (tui-set-props-test-component))) (tui-with-rendered-element test-component (tui--set-props test-component '(:b 100)) (expect (plist-get (tui--get-props test-component) :a) :to-equal 1234)))))) (describe "tui--set-state" (it "causes an update when NO-UPDATE is nil") (it "does not update when NO-UPDATE is truthy")) (describe "tui-render-with-buffer" (it "accepts a single content item" (expect (with-current-buffer (tui-render-with-buffer "*test1*" "foo") (buffer-substring-no-properties (point-min) (point-max))) :to-equal "foo")) (it "accepts multiple content items" (with-current-buffer (tui-render-with-buffer "*test2*" "a" "b" "c") (expect (buffer-substring-no-properties (point-min) (point-max)) :to-equal "abc")))) (describe "tui-component") ================================================ FILE: test/tui-defun.el ================================================ (require 'buttercup) (require 'tui-defun) (describe "tui-defun" (it "preserves operation of declare forms?")) ================================================ FILE: test/tui-dev-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "tui-find-definition") ================================================ FILE: test/tui-layout-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "layout") ================================================ FILE: test/tui-marker-list-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-marker-list) (describe "tui-marker-list-create" (it "returns a marker list" (expect (tui-marker-list-p (tui-marker-list-create)))) (it "accepts an initial list of markers" (with-temp-buffer (let* ((a (point-marker)) (b (progn (insert "foo") (point-marker))) (c (progn (insert "bar") (point-marker))) (marker-list (tui-marker-list-create (list a b c)))) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 3) (expect (tui-marker-list-markers marker-list) :to-equal (list a b c))))) (it "the initial list may contain coincident markers" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c)))) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 3) (expect (tui-marker-list-markers marker-list) :to-equal (list a b c)))))) (describe "tui-marker-list-insert" (it "inserts markers" (with-temp-buffer (let ((marker-list (tui-marker-list-create)) (a (point-marker))) (tui-marker-list-insert marker-list a) (expect (tui-marker-list-markers marker-list) :to-equal (list a))))) (it "returns a marker node" (with-temp-buffer (let ((marker-list (tui-marker-list-create)) (a (point-marker))) (expect (tui-marker-list-node-p (tui-marker-list-insert marker-list a)))))) (xit "rejects markers from other buffers" (with-temp-buffer (let* ((marker-list (tui-marker-list-create)) (alt-buffer (get-buffer-create "another-buffer")) (alt-buffer-marker (with-current-buffer alt-buffer (point-marker)))) (tui-marker-list-insert marker-list 1) ;; TODO: improper spec for buttercup? (expect (tui-marker-list-insert marker-list alt-buffer-marker) :to-throw 'error)))) (it "accepts buffer positions" (with-temp-buffer (insert "foo") (let* ((marker-list (tui-marker-list-create)) (a (tui-marker-list-insert marker-list 1)) (b (tui-marker-list-insert marker-list 3))) (expect (marker-position (tui-marker-list-node-marker a)) :to-be 1) (expect (marker-position (tui-marker-list-node-marker b)) :to-be 3)))) (it "applies buffer positions to the marker-list buffer" (let* ((marker-list (tui-marker-list-create)) marker-a marker-b) (with-temp-buffer (insert "foo") (setq marker-a (tui-marker-list-node-marker (tui-marker-list-insert marker-list 1))) (with-temp-buffer (setq marker-b (tui-marker-list-node-marker (tui-marker-list-insert marker-list 3)))) (expect (marker-buffer marker-a) :to-be (marker-buffer marker-b))))) (xit "rejects invalid buffer positions" (with-temp-buffer (insert "foo") (let ((marker-list (tui-marker-list-create))) ;; TODO: improper spec for buttercup? (expect (tui-marker-list-insert marker-list 5) :to-throw 'error)))) (it "rejects coincident markers") (it "accepts markers from different buffers after the list has been cleared")) (describe "tui-marker-list-remove" (it "can remove the first marker" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c)))) (tui-marker-list-remove marker-list a) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 2) (expect (tui-marker-list-markers marker-list) :to-equal (list b c))))) (it "can remove an interior marker" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c)))) (tui-marker-list-remove marker-list b) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 2) (expect (tui-marker-list-markers marker-list) :to-equal (list a c))))) (it "can remove the last marker" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c)))) (tui-marker-list-remove marker-list c) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 2) (expect (tui-marker-list-markers marker-list) :to-equal (list a b))))) (it "can remove the only marker in a list" (with-temp-buffer (let* ((a (point-marker)) (marker-list (tui-marker-list-create (list a)))) (tui-marker-list-remove marker-list a) (expect (tui-marker-list-p marker-list)) (expect (tui-marker-list-length marker-list) :to-be 0) (expect (tui-marker-list-markers marker-list) :to-equal nil))))) (describe "tui-marker-list-split-marker" (it "split markers are distinct, but have the same position" (with-temp-buffer (insert "foobar") (-let* ((marker-list (tui-marker-list-create)) (node (tui-marker-list-insert marker-list 3)) ((left right) (tui-marker-list-split-marker marker-list 3))) (expect left :not :to-be right) (expect left :to-equal right) (expect (tui-marker-list-valid-p marker-list))))) (it "performs multiple splits" (with-temp-buffer (-let* ((a (point-marker)) (b (point-marker)) (marker-list (tui-marker-list-create (list a b))) (splits (tui-marker-list-split-marker marker-list a 4))) (expect (length splits) :to-be 5) (expect (length (tui-marker-list--all-nodes marker-list)) :to-be 6) (expect (tui-marker-list-valid-p marker-list))))) (it "performs multiples splits on nodes" (with-temp-buffer (-let* ((a (point-marker)) (b (point-marker)) (marker-list (tui-marker-list-create)) (node-a (tui-marker-list-insert marker-list a)) (node-b (tui-marker-list-insert marker-list b)) (splits (tui-marker-list-split-node marker-list node-a 4))) (expect (length splits) :to-be 5) (expect (length (tui-marker-list--all-nodes marker-list)) :to-be 6) (expect (tui-marker-list-valid-p marker-list)))))) (describe "tui-marker-list-open-segment" (it "sets the insertion type for identified nodes" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (d (progn (insert "foo") (point-marker))) (marker-list (tui-marker-list-create (list a b c d)))) (tui-marker-list-open-segment marker-list a b) (expect (mapcar #'marker-insertion-type (tui-marker-list-markers marker-list)) :to-equal (list nil t t nil))))) (it "sets the insertion type for all adjacent coincident nodes" (with-temp-buffer (let* ((a (point-marker)) (b (point-marker)) (c (point-marker)) (d (point-marker)) (marker-list (tui-marker-list-create (list a b c d)))) (tui-marker-list-open-segment marker-list a b) (expect (mapcar #'marker-insertion-type (tui-marker-list-markers marker-list)) :to-equal (list nil t t t)))))) (describe "tui-marker-list-next" (it "returns the next marker" (with-temp-buffer (let* ((a (progn (insert "foo") (point-marker))) (b (progn (insert "bar") (point-marker))) (marker-list (tui-marker-list-create (list a b)))) (expect (tui-marker-list-next-marker marker-list a) :to-equal b))))) (describe "tui-marker-list-previous" (it "returns the previous marker" (with-temp-buffer (let* ((a (progn (insert "foo") (point-marker))) (b (progn (insert "bar") (point-marker))) (marker-list (tui-marker-list-create (list a b)))) (expect (tui-marker-list-prev-marker marker-list a) :to-equal b))))) (describe "tui-marker-list-move-segment" (it "can move a segment that doesn't contain any markers" (with-temp-buffer (-let* ((a (point-marker)) (b (progn (insert "bar") (point-marker))) (c (progn (insert "foo") (point-marker))) (marker-list (tui-marker-list-create (list a b c))) ((target-start target-end) (tui-marker-list-split-marker marker-list a))) (tui-marker-list-move-segment marker-list b c target-start target-end) (expect (buffer-string) :to-equal "foobar") (expect (tui-marker-list-markers marker-list) :to-equal (list target-start target-end b c))))) (it "can move a segment that contains multiple markers" (with-temp-buffer (-let* ((a (prog1 (point-marker) (insert "foo"))) (b (prog1 (point-marker) (insert "bar "))) (c (prog1 (point-marker) (insert "(1"))) (d (prog1 (point-marker) (insert " 2 "))) (e (prog1 (point-marker) (insert "3)"))) (f (prog1 (point-marker) (insert "."))) (g (point-marker)) (marker-list (tui-marker-list-create (list a b c d e f g))) ((target-start target-end) (tui-marker-list-split-marker marker-list b))) (tui-marker-list-move-segment marker-list c f target-start target-end) (expect (buffer-string) :to-equal "foo(1 2 3)bar .") (expect (tui-marker-list-markers marker-list) :to-equal (list a target-start d e target-end c f g)))))) (describe "tui-marker-list-nodes-in-range" (it "returns adjacent nodes" (with-temp-buffer (-let* ((a (prog1 (point-marker) (insert "foo"))) (b (point-marker)) (marker-list (tui-marker-list-create (list a b))) (nodes (tui-marker-list-markers-in-range marker-list a b))) (expect (cl-first nodes) :to-be a) (expect (cl-second nodes) :to-be b)))) (it "returns non-adjacent nodes" (with-temp-buffer (-let* ((a (prog1 (point-marker) (insert "foo"))) (b (prog1 (point-marker) (insert "bar "))) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c))) (nodes (tui-marker-list-markers-in-range marker-list a c))) (expect (nth 0 nodes) :to-be a) (expect (nth 1 nodes) :to-be b) (expect (nth 2 nodes) :to-be c))))) (describe "tui-marker-list-nodes-between" (it "find no nodes between adjacent nodes" (with-temp-buffer (-let* ((a (prog1 (point-marker) (insert "foo"))) (b (point-marker)) (marker-list (tui-marker-list-create (list a b)))) (expect (car (tui-marker-list-markers-between marker-list a b)) :to-be nil)))) (it "find nodes between non-adjacent nodes" (with-temp-buffer (-let* ((a (prog1 (point-marker) (insert "foo"))) (b (prog1 (point-marker) (insert "bar "))) (c (point-marker)) (marker-list (tui-marker-list-create (list a b c)))) (expect (car (tui-marker-list-markers-between marker-list a c)) :to-be b))))) ================================================ FILE: test/tui-reconciler-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui) ;; (require 'tui-div) (require 'tui-heading "components/tui-heading.el") (require 'buttercup) (describe "tui-diff" (it "recognizes equivalent empty elements" (expect (tui--diff (tui-div) (tui-div)) :to-be nil)) (it "recognizes equivalent elements with basic content" (expect (tui--diff (tui-div 1) (tui-div 1)) :to-be nil) (expect (tui--diff (tui-div "foo") (tui-div "foo")) :to-be nil)) (it "identifies basic content differences" (let* ((operations (tui--diff (tui-div "foo") (tui-div "bar")))) (expect (length operations) :to-be 1) (expect (caar operations) :to-be 'update-props))) (it "identifies a nested content difference" (let* ((operations (tui--diff (tui-div (tui-span "foo")) (tui-div (tui-span "bar"))))) (expect (length operations) :to-be 1) (expect (caar operations) :to-be 'update-props) (expect (tui--type (cadar operations)) :to-be 'tui-div))) (it "only updates an element for changed children if one of its children would not be reference-equal") (it "diffs a mounted element with a fresh element" (let* ((div (tui-div (tui-span 1)))) (tui-with-rendered-element div (tui--diff div (tui-div (tui-span 1))))))) (describe "tui-reconciler" (it "is called on a basic property change" (spy-on 'tui--reconcile-content) (let ((div (tui-div "foo"))) (tui-with-rendered-element div (tui--set-props div '(:children "bar")) (expect 'tui--reconcile-content :to-have-been-called)))) (it "yields basic patches" (let ((patches (tui--diff (tui-create-element 'tui-div nil "foo") (tui-create-element 'tui-heading nil "bar")))) (expect (length patches) :to-equal 1) (expect (car (cl-first patches)) :to-equal 'replace)) (let ((patches (tui--diff (tui-heading "foo") (tui-heading "bar")))) (expect (length patches) :to-equal 1) (expect (car (cl-first patches)) :to-equal 'update-props)))) (describe "tui-patch" (describe "insert operation" (it "does a basic insert") (it "can fully rotate a list forward") (it "can fully rotate a list backwards")) (describe "remove operation" (it "can remove the last remaining element of a list" ) (it "can remove an element from the beginning of a list") (it "can remove an alement from the end of a list") (it "can remove an element from the middle of a list") (it "can remove an only child element")) (describe "replace operation" (it "can replace an element at the beginning of a list") (it "can replace an element at the end of a list") (it "can replace an element in the middle of a list") (it "can remove replace an only child element")) (describe "change-props operation") (describe "reorder operation")) (provide 'tui-diff-test) ================================================ FILE: test/tui-shared-size-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui-shared-size) (require 'tui-fixed-width "components/tui-fixed-width.el") (require 'tui-line "components/tui-line.el") (describe "tui-shared-size" (it "can resize a single element" (let* ((shared-size (tui-shared-size-create)) (content "The quick brown fox") (fixed-width-content (tui-fixed-width :width shared-size :content content))) (tui-with-rendered-element (tui-line fixed-width-content) (tui-recalculate-size shared-size) (expect (tui-visible-width fixed-width-content) :to-equal (tui-size shared-size))))) (it "can resize multiple elements") (it "can resize multiple adjacent elements") (it "works with other adjacent tui-shared-size elements" (let* ((content-elements '(("foo" "foobar" "a") ("wasd" "b" "bazbat"))) (column-sizes (list (tui-shared-size-create) (tui-shared-size-create) (tui-shared-size-create))) (content-components (list (list (tui-fixed-width :width (nth 0 column-sizes) :children (nth 0 (nth 0 content-elements))) (tui-fixed-width :width (nth 1 column-sizes) :children (nth 1 (nth 0 content-elements))) (tui-fixed-width :width (nth 2 column-sizes) :children (nth 2 (nth 0 content-elements)))) (list (tui-fixed-width :width (nth 0 column-sizes) :children (nth 0 (nth 1 content-elements))) (tui-fixed-width :width (nth 1 column-sizes) :children (nth 1 (nth 1 content-elements))) (tui-fixed-width :width (nth 2 column-sizes) :children (nth 2 (nth 1 content-elements)))))) (content (list (apply #'tui-line (nth 0 content-components)) (apply #'tui-line (nth 1 content-components))))) (tui-with-rendered-element content (mapc #'tui-recalculate-size column-sizes) ;;(buffer-substring-no-properties (point-min) (point-max)))) ;;(oref (cl-first column-sizes) :element-sizes))) ;; (message "width: %S" (tui-visible-width (nth 0 (nth 0 content-components)))) ;; (message "width: %S" (tui-visible-width (nth 1 (nth 0 content-components)))) ;; (message "width: %S" (tui-visible-width (nth 2 (nth 0 content-components)))) (expect (tui-visible-width (nth 0 (nth 0 content-components))) :to-equal (tui-visible-width (nth 0 (nth 1 content-components)))) (expect (tui-visible-width (nth 1 (nth 0 content-components))) :to-equal (tui-visible-width (nth 1 (nth 1 content-components)))) (expect (tui-visible-width (nth 2 (nth 0 content-components))) :to-equal (tui-visible-width (nth 2 (nth 1 content-components)))))))) ;; (let ((my/width (tui-shared-size-create :element-sizes '(1 2 3)))) ;; (push 10 (oref my/width :element-widths)) ;; (tui-width my/width)) ;; (progn ;; (erase-buffer) ;; (setq-local content-elements '(("foo" "foobar" "a") ;; ("wasd" "b" "bazbat"))) ;; (setq-local column-sizes (list (tui-shared-size-create) ;; (tui-shared-size-create) ;; (tui-shared-size-create))) ;; (setq-local content-components (list (list (tui-fixed-width :width (nth 0 column-sizes) :content (nth 0 (nth 0 content-elements))) ;; (tui-fixed-width :width (nth 1 column-sizes) :content (nth 1 (nth 0 content-elements))) ;; (tui-fixed-width :width (nth 2 column-sizes) :content (nth 2 (nth 0 content-elements)))) ;; (list (tui-fixed-width :width (nth 0 column-sizes) :content (nth 0 (nth 1 content-elements))) ;; (tui-fixed-width :width (nth 1 column-sizes) :content (nth 1 (nth 1 content-elements))) ;; (tui-fixed-width :width (nth 2 column-sizes) :content (nth 2 (nth 1 content-elements)))))) ;; (setq-local content (list (apply #'tui-line (nth 0 content-components)) ;; (apply #'tui-line (nth 1 content-components)))) ;; (tui-render-element content) ;; (mapc #'tui-recalculate-size column-sizes)) (provide 'tui-shared-size-test) ================================================ FILE: test/tui-tabstops-test.el ================================================ (require 'buttercup) (require 'tui) (describe "tabstops" (describe "tui-forward-tabstop" (it "does nothing (and doesn't error) if grid is empty")) (it "loop (back to the beginning)") (it "preserve editing state" ;; editing ;; tab ;; expect editing ;; (not editing) ;; tab ;; expect (not editing) ) (it "create a new record when editing the last record of the last row and recordCreate is t") (it "loops properly when grid only has a single item") (it "tabs through footer cells") (it "tabs through header cells?")) (describe "tui--target-row-offset" (progn (expect (tui--target-row-offset 5 2 -2) :to-equal 0) (expect (tui--target-row-offset 5 2 -3) :to-equal -1) (expect (tui--target-row-offset 5 2 -1) :to-equal 0) (expect (tui--target-row-offset 5 0 -1) :to-equal -1) (expect (tui--target-row-offset 5 0 0) :to-equal 0) (expect (tui--target-row-offset 5 0 1) :to-equal 0))) (describe "tui--target-column-index" (progn (expect (tui--target-column-index 5 2 -2) :to-equal 0) (expect (tui--target-column-index 5 2 -3) :to-equal 4) (expect (tui--target-column-index 5 2 -1) :to-equal 1) (expect (tui--target-column-index 5 0 -1) :to-equal 4) (expect (tui--target-column-index 5 0 0) :to-equal 0) (expect (tui--target-column-index 5 0 1) :to-equal 1))) ================================================ FILE: test/tui-test-helper.el ================================================ ;;; test-helper.el --- tui.el: Unit-test setup -*- lexical-binding: t; -*- ;; (when (require 'undercover nil t) ;; (undercover "*.el")) (provide 'tui-test-helper) ;;; test-helper.el ends here ================================================ FILE: test/tui-test.el ================================================ (require 'tui-test-helper "test/tui-test-helper.el") (describe "basic composition" (describe "preservation of child text properties") (describe "overriding child text properties")) ================================================ FILE: test/tui-text-props-test.el ================================================ (require 'buttercup) (require 'tui-test-helper "test/tui-test-helper.el") (require 'tui) (require 'tui-text-props) (describe "tui--extend-text-props" (it "merges empty sets" (expect (tui--extend-text-props nil '(nil nil nil nil)) :to-be nil)) (it "merges values with expected inheritance" ;; TODO: need a plist-equal function to make this more robust... (expect (tui--plist-equal (tui--extend-text-props '(:a 1 :b "foo" :c "baz") '((:b "bar")(:a 0)(:a 2)(:c "bat" :d "blah"))) '(:d "blah" :c "baz" :b "bar" :a (0 1 2)))))) (describe "tui--get-grouped-text-props" (it "should return a list of length 4" (expect (length (tui--get-grouped-text-props (tui-span :text-props-push '(:a 0) "foo"))) :to-be 4)) (it "should return a properly grouped values" (-let* ((span (tui-span :text-props-push '(:a 1) :text-props-replace '(:b 2) :text-props-append '(:c 3) :text-props-safe '(:d 4) "foo")) ((replace push append safe) (tui--get-grouped-text-props span))) (expect push :to-equal '(:a 1)) (expect replace :to-equal '(:b 2)) (expect append :to-equal '(:c 3)) (expect safe :to-equal '(:d 4))))) (describe "inheritance of rendered elements" (it "applies basic inheritance" (let* ((child (tui-span "foo"))) (tui-with-rendered-element (tui-div :text-props '(:a 1) child "bar") (expect (get-text-property (tui-start tui-element) :a) :to-equal 1)))) (it "applies safe inheritance properties" (let* ((child (tui-span :text-props-safe '(:a 0) "foo"))) (tui-with-rendered-element (tui-div :text-props '(:a 1) child "bar") (expect (get-text-property (tui-start tui-element) :a) :to-equal 1)))) (it "applies replace inheritance properties" (let* ((child (tui-span :text-props-replace '(:a 0) "foo"))) (tui-with-rendered-element (tui-div :text-props '(:a 1) child "bar") (expect (get-text-property (tui-start child) :a) :to-equal 0)))) (it "applies push inheritance properties" (let* ((child (tui-span :text-props-push '(:a 0) "foo")) (div (tui-div :text-props '(:a 1) child "bar"))) (tui-with-rendered-element div (expect (get-text-property (tui-start child) :a) :to-equal '(0 1))))) (it "applies append inheritance properties" (let* ((child (tui-span :text-props-append '(:a 2) "foo"))) (tui-with-rendered-element (tui-div :text-props '(:a 1) child "bar") (expect (get-text-property (tui-start child) :a) :to-equal '(1 2))))) (it "merges values with expected inheritance")) ================================================ FILE: test/tui-util-test.el ================================================ (require 'buttercup) (require 'tui-test-helper "test/tui-test-helper.el") (require 'cl) (require 'tui-core) (describe "tui-put-text-properties" (describe "inheritance rules" (describe "replace" (it "replaces existing properties regardless of their policies")) (describe "push") (describe "append") (describe "safe" (it "applies properties") (it "does not affect existing properties")))) (describe "tui--plist-delete" (it "doesn't alter the list if a key doesn't exist" (let* ((foo '(:a 1 :b 2 :c 3)) (bar (tui--plist-delete foo :d))) (expect foo :to-equal bar))) (it "deletes a single property" (let* ((foo '(:a 1 :b 2 :c 3)) (bar (tui--plist-delete foo :b))) (expect (plist-get bar :a) :to-equal 1) (expect (plist-get bar :b) :to-equal nil) (expect (plist-member bar :b) :to-equal nil) (expect (plist-get bar :c) :to-equal 3))) (it "deletes multiple properties" (let* ((foo '(:a 1 :b 2 :c 3)) (bar (tui--plist-delete foo :b :a))) (expect (plist-get bar :a) :to-equal nil) (expect (plist-member bar :a) :to-equal nil) (expect (plist-get bar :b) :to-equal nil) (expect (plist-member bar :b) :to-equal nil) (expect (plist-get bar :c) :to-equal 3)))) (describe "tui--plist-equal" (it "judges equality independent of order" (expect (tui--plist-equal '(:a 1 :b 2) '(:b 2 :a 1)) :to-be t) (expect (tui--plist-equal '(:a 1 :b 2) '(:b 2 :a 1 :c 3)) :to-be nil) (expect (tui--plist-equal '(:a 1 :b 2 :c 3) '(:b 2 :a 1)) :to-be nil))) (describe "tui-unintern" (before-each (tui-define-component test-component :get-initial-state (lambda () (list :foo "bar")) :render (lambda () "test component")) (tui-unintern 'test-component)) (it "has an interactive form" (expect (interactive-form 'tui-unintern))) (it "removes component constructor" (expect (symbol-function 'test-component) :to-be nil)) (xit "removes the struct definition" (expect (cl--find-class 'test-component) :to-be nil)) (it "removes generic methods" (expect (-none-p (lambda (generic) (equal 'test-component (car (cl--generic-method-specializers generic)))) (cl--generic-method-table (cl-generic-ensure-function 'tui-get-initial-state)))))) (describe "tui-equal" (it "behaves like equal for non-lisp, non-tui types" (expect (tui-equal nil nil) :to-be t) (expect (tui-equal "foo" "foo") :to-be t) (expect (tui-equal "2" 2) :to-be nil) (expect (tui-equal "foo" nil) :to-be nil)) (it "fresh objects without children are identical" (expect (tui-equal (tui-div) (tui-div))))) (describe "tui--plist-changes" (it "compares empty lists" (expect (tui--plist-changes nil nil) :to-be nil)) (it "identifies differences" (expect (tui--plist-changes '(:a 1 :b 2 :c 3) '(:a 1 :b 4 :c 3)) :to-equal '(:b 4)) (expect (tui--plist-changes '(:a 1 :b 2) '(:a 2 :b 2 :c 2)) :to-equal '(:a 2 :c 2))) ;; TODO: reconsider this behavior? (it "uses tui-equal to compare items" (spy-on 'tui-equal) (expect (tui--plist-changes '(:a (1 2 3)) '(:a (1 2 3))) :to-equal '(:a (1 2 3))) (expect 'tui-equal :to-have-been-called))) (describe "tui--type" (it "returns nil for an unknown object type" (expect (tui--type nil) :to-be nil) (expect (tui--type '(1)) :to-be nil) (expect (tui--type [1]) :to-be nil))) ================================================ FILE: tui-components.el ================================================ (require 'tui-button "components/tui-button.el") (require 'tui-buffer "components/tui-buffer.el") (require 'tui-div "components/tui-div.el") (require 'tui-expander "components/tui-expander.el") (require 'tui-fixed-width "components/tui-fixed-width.el") (require 'tui-heading "components/tui-heading.el") (require 'tui-icon "components/tui-icon.el") (require 'tui-line "components/tui-line.el") (require 'tui-link "components/tui-link.el") (require 'tui-ol "components/tui-ol.el") (require 'tui-ul "components/tui-ul.el") (require 'tui-span "components/tui-span.el") (require 'tui-spinner "components/tui-spinner.el") (require 'tui-timer "components/tui-timer.el") (require 'tui-prefix-lines "components/tui-prefix-lines.el") (provide 'tui-components) ================================================ FILE: tui-core.el ================================================ ;;; tui-core.el --- Core functions -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (require 's) (require 'tui-dom) (require 'tui-reconciler) (require 'tui-layout) (require 'tui-log) (require 'tui-marker-list) (require 'tui-node-types) (require 'tui-ref) (require 'tui-text-props) ;;; Content constants ;;; Code: (declare-function tui-marker-list-node-start "tui-marker-list.el") (declare-function tui-marker-list-node-end "tui-marker-list.el") (defvar tui-this-component) (defvar tui-error-placeholder-string "�" "Placeholder string to indicate a broken component.") (defvar tui--update-queue nil "Queue of updates to be committed.") (defvar tui--applying-updates nil "Dynamic scope variable to indicate whether queued updates are being processed.") (defvar tui-update-hook nil "Run after the update queue has been cleared.") (defvar-local tui--buffer-modified-p nil "Internally track modified buffers that should be updated.") ;;; Component lifecycle methods (cl-defgeneric tui-get-default-props () (:documentation "Return default properties for all instances of the component type. Equivalent to React's createReactClass form: https://reactjs.org/docs/react-without-es6.html#declaring-default-props")) (cl-defmethod tui-get-default-props ((_component tui-component)) "Empty default method" nil) (cl-defgeneric tui-get-initial-state () (:documentation "Return the initial component state for a new component instance. Equivalent to React's createReactClass form: https://reactjs.org/docs/react-without-es6.html#setting-the-initial-state")) (cl-defmethod tui-get-initial-state ((_component tui-component)) "Empty default method" nil) (cl-defgeneric tui-component-did-mount () (:documentation "Called immediately after a component is mounted. `tui-set-state' may be used in this method. React documentation: https://reactjs.org/docs/react-component.html#componentdidmount")) (cl-defmethod tui-component-did-mount ((_component tui-component)) "Empty default method" nil) (cl-defgeneric tui-get-derived-state-from-props (props state) (:documentation "Return a plist of any state values derived from PROPS or the current STATE. React documentation: https://reactjs.org/docs/react-component.html#static-getderivedstatefromprops")) (cl-defmethod tui-get-derived-state-from-props ((_component tui-component) _props _state) "Empty default method" nil) (cl-defgeneric tui-should-component-update (next-props next-state) (:documentation "Performance optimization method to prevent component updates. Return nil to indicate that the component's output is not affected by the current change in props or state. React documentation: https://reactjs.org/docs/react-component.html#shouldcomponentupdate")) (cl-defmethod tui-should-component-update ((_component tui-component) _next-props _next-state) "Empty default method" t) (cl-defgeneric tui-render () (:documentation "Return the component output content. React documentation: https://reactjs.org/docs/react-component.html#render")) (cl-defmethod tui-render ((_component tui-component)) "Empty default method" nil) (cl-defgeneric tui-component-did-update (next-props next-state) (:documentation "Is called after all component updates. It is not called for the initial render. React documentation: https://reactjs.org/docs/react-component.html#componentdidupdate")) (cl-defmethod tui-component-did-update ((_component tui-component) _next-props _next-state) "Empty default method" nil) (cl-defgeneric tui-component-will-unmount (:documentation "Called immediately before a component will unmount. React documentation: https://reactjs.org/docs/react-component.html#componentwillunmount")) (cl-defmethod tui-component-will-unmount ((_component tui-component)) "Empty default method" nil) ;;;; Internal Lifecycle helpers (defun tui--lifecycle-funcall (func component &rest args) "Internal helper for invoking lifecycle methods. Calls FUNC for COMPONENT (ARGS are arguments for the lifecycle method) and appropriately binds `tui-get-props' and `tui-get-state'." (cl-assert (functionp func)) ;; CLEANUP: eliminate `component' reference here in favor of `tui-this-component': (let* ((component component) (tui-this-component component)) (tui--easy-going-apply func (apply #'list component args)))) (defalias 'tui--funcall 'tui--lifecycle-funcall) (cl-defmethod tui--mount ((node tui-node) start &optional end parent marker-list) "Internal use only. Mount and insert NODE between START and END divisions. Return NODE." (when (tui-node-mounted node) (error "Component already mounted")) ;; CLEANUP: need a better solution to indicate the desired mount is in progress (setf (tui-node-mounted node) 'pending) (tui--set-parent node parent marker-list) (unless end (setq end start)) (cl-assert (tui-marker-list-node-p start) t "Mount point is a tui-marker-list-node") (cl-assert (tui-marker-list-node-p end) t "Mount point is a tui-marker-list-node") (when (eq start end) (-let* (((start-division end-division) (tui--split-division node start))) (setq start start-division) (setq end end-division))) (setf (tui-node-start node) start) (setf (tui-node-end node) end) (when (and (tui-element-p node) (not (tui-component-p node))) (setf (tui-element-content node) (tui--normalize-content (plist-get (tui--get-props node) :children)))) ;; (display-warning 'tui-diff (format "MOUNT %S between %S and %S (%s)" (tui--object-class node) start end (unless (eq start end) "eq" "distinct")) :debug tui-log-buffer-name) (tui--insert node) (if parent (tui--apply-inherited-text-props (tui-start node) (tui-end node) parent (marker-buffer (tui-start node))) (-when-let* ((marker (tui-start node)) (buffer (and (markerp start) (marker-buffer marker)))) (when (buffer-live-p buffer) (with-current-buffer buffer (unless tui--content-trees (add-hook 'kill-buffer-hook #'tui-unmount-current-buffer-content-trees nil t)) (add-to-list 'tui--content-trees component))))) (setf (tui-node-mounted node) t) ;; (cl-assert (or (< start end) ;; (eq start end)) t "Segment endpoints should be ordered if not represented by the same marker.") node) (cl-defmethod tui--mount ((component tui-component) start &optional end parent marker-list) "Internal use only. Mount and insert COMPONENT between START and END divisions. Return COMPONENT." (when (tui-node-mounted component) (error "Component already mounted")) ;; Build the prop list for this instance (setf (tui-component-props component) (tui--plist-merge (tui-get-default-props component) (tui--get-props component))) (let* ((initial-state (tui--funcall #'tui-get-initial-state component)) (derived-state (tui--funcall #'tui-get-derived-state-from-props component (tui-component-props component) initial-state))) ;; Set the initial state (w/o forcing an update) (tui--set-state component (tui--plist-merge initial-state derived-state) t)) ;; Call the component render method (setf (tui-component-content component) (tui--normalize-content (tui--funcall #'tui-render component))) ;; TODO: condition-case -> tui-error-placeholder-string (setf tui--update-queue (append (let ((tui--update-queue nil)) (cl-call-next-method) tui--update-queue) `((component-did-mount ,component)) tui--update-queue)) component) (cl-defmethod tui--insert ((node tui-node)) "Default (empty method)." node) (cl-defmethod tui--insert ((text-node tui-text-node)) "Insert content of TEXT-NODE." (cl-assert (tui-text-node-mounted text-node) t "Can only insert nodes once they have been mounted.") ;; "Open" markers, so insertion takes place between them ;;(tui--with-open-node text-node (save-current-buffer (save-excursion (save-restriction (widen) (tui--open-segment text-node) (let ((start (tui-start text-node)) (end (tui-end text-node)) (parent (tui-parent text-node))) (tui--goto start) (delete-region start end) (-when-let* ((content (tui-text-node-content text-node)) (string (tui--get-string content))) ;; (unless (get-text-property 0 'tui-node string) ;; (put-text-property start end 'tui-node text-node (marker-buffer start))) (insert string)) (tui-put-text-property start end 'tui-node text-node (marker-buffer start) nil) (tui--apply-inherited-text-props start end text-node (marker-buffer start))) (cl-incf (tui-node-update-count text-node)) (setq tui--buffer-modified-p t))))) (cl-defmethod tui--insert ((element tui-element)) "Insert content of ELEMENT." (cl-assert (tui-element-mounted element) t "Can only insert nodes once they have been mounted.") ;; Invisible elements don't get inserted (unless (tui-invisible-p element) (-when-let* ((children (tui-child-nodes element))) (if (eq (tui-node-mounted (cl-first children)) t) (mapcar #'tui--insert children) (let* ((marker-list (tui-node-marker-list element)) (subdivisions (cl-rest (tui-marker-list-split-node marker-list (tui--start-division element) (* (length children) 2)))) (i 0)) (tui--update-node-index-positions children) (cl-loop for child in children for (left-division right-division) on subdivisions by #'cddr do (cl-assert (tui-marker-list--nodes-adjacent-p left-division right-division) t "We should be looking at adjacent divisions") (push (list 'mount child left-division right-division element) tui--update-queue)) (setq i (+ i 1)))))) (cl-incf (tui-node-update-count element))) (cl-defmethod tui--update ((text-node tui-text-node)) "Update displayed element." (tui--insert text-node)) (cl-defmethod tui--update ((element tui-element) &optional (next-props nil next-props-supplied-p)) "Update ELEMENT." (save-excursion (let* ((props (if next-props-supplied-p (setf (tui-element-props element) next-props) (tui--get-props element))) (old-content (tui-element-content element)) (new-content (tui--normalize-content (plist-get props :children)))) ;; condition-case -> tui-error-placeholder-string element (tui--reconcile-content old-content new-content element) element))) (cl-defmethod tui--update ((component tui-component) &optional next-props next-state force) "Update COMPONENT." (save-current-buffer (save-excursion (let* ((next-props (or next-props (tui--get-props component))) (next-state (or next-state (tui--get-state component))) (prev-props (tui--get-props component)) (prev-state (tui--get-state component)) (old-content (tui-component-content component))) ;; TODO: restore ;; (-when-let* ((changed-text-props (tui--text-prop-changes prev-props next-props))) ;; (push `(update-text-props ,component ,changed-text-props) tui--update-queue)) (setf (tui-component-props component) next-props) (setf (tui-component-state component) next-state) (let* ((new-content (tui--normalize-content (tui--funcall #'tui-render component)))) ;; condition-case -> tui-error-placeholder-string element (tui--reconcile-content old-content new-content component) (push `(component-did-update ,component ,prev-props ,prev-state) tui--update-queue) component))))) (cl-defmethod tui--unmount ((node tui-node)) "Internal use only. Unmount COMPONENT, but leave unmounted component in its current context. Replacement/removal of COMPONENT should be handled by the calling method. Returns NODE." (-let* (((start . end) (tui-segment--nodes node)) (parent (tui-parent node)) (inhibit-read-only t)) (save-current-buffer (save-excursion (when (tui-node-mounted node) (when parent (remhash node tui--element-parent-table) (setf (tui-node-content parent) (remove node (tui-element-content parent))) (tui--update-node-index-positions (tui-child-nodes parent))) (tui--goto (tui-start node)) (delete-region (tui-marker-list-node-marker start) (tui-marker-list-node-marker end)) (tui-marker-list-delete-node-segment (tui-node-marker-list node) start end) (setf (tui-node-mounted node) nil) node))))) (cl-defmethod tui--unmount ((element tui-element)) "Internal use only. Unmount COMPONENT, but leave unmounted component in its current context. Replacement/removal of COMPONENT should be handled by the calling method. Returns ELEMENT." (mapc #'tui--unmount (tui-child-nodes element)) (cl-call-next-method) (tui--make-ref-callback element t) element) (cl-defmethod tui--unmount ((component tui-component)) "Internal use only. Unmount COMPONENT, but leave unmounted component in its current context. Replacement/removal of COMPONENT should be handled by the calling method. Returns COMPONENT." (tui--funcall #'tui-component-will-unmount component) (cl-call-next-method) component) ;;; Props and State functions (defvar tui--default-props-table (make-hash-table) "Default props for component classes.") ;; (defun tui-get-props () ;; "Get current component properties from within a lifecycle method of a component." ;; (error "`tui-get-props' must be called from within a component lifecycle method")) (cl-defun tui-get-props (&optional node) "Return a list of NODE's properties." (if node (tui--get-props node) (tui-element-props tui-this-component))) (cl-defmethod tui--get-props ((element tui-element)) "Internal use only." (tui-element-props element)) (cl-defmethod tui--get-props ((node tui-node)) "Internal use only." nil) ;; (cl-defmethod tui-get-state () ;; "Get current component state from within a lifecycle method of a component." ;; (or (tui-get-state component) ;; (error "`tui-get-state' must be called from within one of `component-did-mount', or `component-did-update' component lifecycle methods"))) (defun tui-get-state (&optional component) "Get current component state." (if component (tui--get-state component) (tui--get-state tui-this-component))) (defun tui--get-state (component) "Internal function to get COMPONENT state. Do not call this directly; use `tui-get-state' within one of `component-did-mount', or `component-did-update' component lifecycle methods." (cl-copy-list (tui-component-state component))) (cl-defmethod tui--set-props ((component tui-component) next-props) "Internal use only." (display-warning 'tui (format "SET-PROPS %S (%d) %s" (tui--object-class component) (tui-node-id component) (tui--plist-keys next-props)) :debug tui-log-buffer-name) (let* ((prev-props (tui--get-props component)) (next-props (tui--plist-merge prev-props next-props)) (prev-state (tui--get-state component)) (next-state (tui--plist-merge (tui--get-state component) (tui-get-derived-state-from-props component next-props prev-state)))) (when (tui--funcall #'tui-should-component-update component next-props next-state) (cl-call-next-method component next-props)))) (cl-defmethod tui--set-props ((element tui-element) next-props) "Internal use only." ;;(display-warning 'tui (format "SET-PROPS %S (%d)" (tui--object-class element) (tui-node-id element)) :debug tui-log-buffer-name) ;;(let ((prev-props (tui--get-props element))) ;; TODO: verify operation ;; (when (tui--text-prop-changes prev-props next-props) ;; ;; TODO ;; ;; (tui--clear-cached-text-props component) ;; ) (tui--update element next-props)) (cl-defmethod tui-component-set-state ((component tui-component) updater &optional no-update) "Internal function to set COMPONENT state. Do not call this directly; use `tui-set-state'. Sets the current state of COMPONENT using UPDATER. UPDATER may be a plist containing partial next state or a function that returns a partial next state plist. Does not cause the component to update when NO-UPDATE is truthy." ;; TODO: Add defensive check to prevent calling within a render call. ;; TODO: Add defensive check to prevent calling without a component reference. Make this a method?! (let* ((prev-state (tui-component-state component)) (new-state (if (functionp updater) (funcall updater (tui--get-state component)) updater)) (next-state (tui--plist-merge prev-state new-state))) (display-warning 'tui (format "SET-STATE %s %S (%d) %S" (if no-update "(no-update)" "") (tui--object-class component) (tui-node-id component) (tui--plist-keys new-state)) :debug tui-log-buffer-name) (when (not (equal prev-state next-state)) ;; XXX: remove this check? (if no-update (setf (tui-component-state component) next-state) (tui--update component nil next-state)) (unless tui--applying-updates (tui--process-update-queue))))) (defalias 'tui--set-state 'tui-component-set-state) (cl-defmethod tui-set-state ((component tui-component) new-state) "Syntactic sugar for ``tui-component-set-state.''" (tui--set-state component new-state)) ;;; Composition API (defmacro tui-with-rendered-element (element &rest body) "Renders ELEMENT in a dedicated temporary buffer. Binds `tui-element' to ELEMENT for evaluation of BODY." (declare (indent defun)) `(with-temp-buffer (let ((tui-element (tui-render-element ,element))) ,@body))) (defun tui-render-to-string (element) "Return the string representation of rendered ELEMENT." (tui-with-rendered-element element (remove-list-of-text-properties (point-min) (point-max) '(tui-node front-sticky rear-nonsticky)) (buffer-string))) (defun tui-create-element (type &optional props &rest children) "Create a new element TYPE with PROPS properties and child elements CHILDREN." (-let* ((invisible (plist-get props :invisible))) (when children (setq props (append props (list :children (if (eq (length children) 1) (car children) children))))) (funcall (intern (format "%s-create" (symbol-name type))) :props props :invisible invisible))) (cl-defmacro tui-define-component (name &key documentation prop-documentation state-documentation get-default-props get-initial-state mount component-did-mount get-derived-state-from-props should-component-update render component-did-update component-will-unmount) "Macro for defining `tui-component' types. Lifecycle signatures: get-default-props () get-initial-state () mount () component-did-mount () get-derived-state-from-props (props state) should-component-update (next-props next-state) render () component-did-update (prev-props prev-state) component-will-unmount () See React's documentation (https://reactjs.org/docs/react-component.html) for a good explanation of how these methods should be used." (declare (indent defun)) (tui--check-key-value-documentation prop-documentation) (tui--check-key-value-documentation state-documentation) (let* ((prop-names (delq nil (cl-loop for (prop-keyword docstring) on prop-documentation by #'cddr collect (intern (substring (symbol-name prop-keyword) 1))))) (method-generated-by "(generated by tui-define-component)")) `(progn ;; Remove the prior component definition (tui-unintern ',name) ;; Define the component struct that all methods are predicated on (tui--component-defstruct ,name) ;; Define implementations of generic lifecycle methods ,(when get-default-props `(cl-defmethod tui-get-default-props ((component ,name)) "" (let ((class (tui--object-class component))) (cl-copy-seq (let* ((cache-value (gethash class tui--default-props-table 'miss))) (if (eq cache-value 'miss) (puthash class (funcall ,get-default-props) tui--default-props-table) cache-value)))))) ,(when get-initial-state `(cl-defmethod tui-get-initial-state ((component ,name)) ,method-generated-by (tui--lifecycle-funcall ,get-initial-state component))) ,(when mount `(cl-defmethod tui--mount ((component ,name) start &optional end parent) ,method-generated-by (tui--lifecycle-funcall ,mount component start end parent))) ,(when component-did-mount `(cl-defmethod tui-component-did-mount ((component ,name)) ,method-generated-by (tui--lifecycle-funcall ,component-did-mount component))) ,(when get-derived-state-from-props `(cl-defmethod tui-get-derived-state-from-props ((component ,name) props state) ,method-generated-by (tui--lifecycle-funcall ,get-derived-state-from-props component props state))) ,(when should-component-update `(cl-defmethod tui-should-component-update ((component ,name) next-props next-state) ,method-generated-by (tui--lifecycle-funcall ,should-component-update component next-props next-state))) ,(when render `(cl-defmethod tui-render ((component ,name)) ,method-generated-by (tui--lifecycle-funcall ,render component))) ,(when component-did-update `(cl-defmethod tui-component-did-update ((component ,name) prev-props prev-state) ,method-generated-by (tui--lifecycle-funcall ,component-did-update component prev-props prev-state))) ,(when component-will-unmount `(cl-defmethod tui-component-will-unmount ((component ,name)) ,method-generated-by (tui--lifecycle-funcall ,component-will-unmount component))) ;; Constructor function (cl-defun ,name ,(append '(&rest args) (apply #'append (mapcar (lambda (prop-name) `(&key ,prop-name)) prop-names)) '(&allow-other-keys)) ,(tui-component--docstring documentation prop-documentation state-documentation) (let (children props) ;; Parse keyword key-value pairs permitting shorthand children (omitted :children) (while (keywordp (car args)) (-let* (((prop value) (-take 2 args))) (setq args (cddr args)) (if (eq prop :children) (setq children value) (setq props (append (list prop value) props))))) (when args (setq children args)) (unless (listp children) (setq children (list children))) ;; TODO: also issue a warning? (let ((component (funcall #'tui-create-element ',name props children))) component)))))) (defun tui-force-update (component) "Force COMPONENT to re-render." (interactive (list (tui-read-element-at-point))) (display-warning 'tui (format "FORCE-UPDATE %S %d" (tui--object-class component) (tui-node-id component)) :debug tui-log-buffer-name) (let* ((new-props (tui--get-props component)) (new-state (tui--get-state component))) (push `(component-did-update ,component ,new-props ,new-state) tui--update-queue) (tui--update component) (unless tui--applying-updates (tui--process-update-queue)))) (cl-defun tui-force-update-buffer (&optional (buffer (current-buffer))) "Update all tui components in BUFFER or current buffer." (interactive) (with-current-buffer buffer (mapc #'tui-force-update tui--content-trees))) ;; (tui-render-with-buffer :: Buffer -> Content... -> Buffer) (cl-defmacro tui-render-with-buffer (buffer &rest content) "Render ELEMENT in dedicated BUFFER and switch to that buffer. Any existing contents of BUFFER will be replaced. Return buffer." (declare (indent 1)) (let* ((content-sym (make-symbol "content-sym")) (buffer-sym (make-symbol "buffer")) (buffer-element-sym (make-symbol "buffer-element"))) `(-let* ((,content-sym (list ,@content)) (,buffer-sym ,buffer)) (tui-render-element (tui-buffer :buffer ,buffer-sym :children ,content-sym)) (switch-to-buffer ,buffer-sym) ,buffer-sym))) (defun tui-render-element (node &optional target) "Primary function for rendering content to a buffer. Input CONTENT is converted to a well-formed content tree. Returns a reference to the root node of the rendered content. Optionally specify TARGET context for rendering NODE. TARGET may be a character position, marker, buffer name, buffer, or another tui-element." (setq tui--update-queue nil) (let* ((inhibit-modification-hooks t)) (save-excursion (save-current-buffer (if (tui-element-p target) (tui-append-child target node) (cond ((number-or-marker-p target) (with-current-buffer (if (markerp target) (marker-buffer target) (current-buffer)) (goto-char target))) ((stringp target) (set-buffer (get-buffer-create target))) ((bufferp target) (set-buffer target))) (let* ((node (tui--make-root-node node)) (marker-list (tui-node-marker-list node))) (tui--mount node (tui-marker-list-insert marker-list (point-marker))) (unless (tui-buffer-p node) (push node tui--content-trees)) (tui--process-update-queue) ;;(tui-valid-content-tree-p node) node)))))) (cl-defmethod tui-rendered-p ((node tui-node)) "Return t if ELEMENT has been rendered." (and (tui-segment node) t)) (cl-defmethod tui-mounted-p ((node tui-node)) "Return t if NODE is mounted in a live buffer and nil otherwise." (and (tui-node-mounted node) (not (eq (tui-node-mounted node) 'pending)) (let* ((start (tui-start node))) (and start (marker-buffer start) ;; (buffer-live-p (marker-buffer start)) )) t)) ;;;; Internal (defun tui--normalize-node (node) "Convert NODE's content tree to normalized form. A normalized content tree: 1. Is represented by a reference to the topmost node which is an instance of `tui-node' (or an inheriting class). 2. All child `tui-node' objects are themselves in normalized form. 3. All `tui-element' nodes contain (in :content slot) a list of `tui-node' objects (zero or more)." (cond ((tui-text-node-p node) ;; TODO: check that content is a primitive node) ((or (tui-element-p node) (tui--list-content-p node)) (tui--normalize-element node)) ((and (featurep 'collection) (tui--object-of-class-p node 'collection)) (tui--normalize-element (collection-to-list node))) ((or (stringp node) (numberp node)) (tui-text-node-create :content node)) (t (error "Unexpected node element type could not be normalized")))) (defun tui--normalize-element (element) "Same as `tui-normalize-node'- except that it ensures that ELEMENT is an instance of `tui-element' (content is wrapped with a `tui-element' if necessary)." (unless (tui-element-p element) (setq element (apply #'tui-create-element 'tui-element nil (tui--normalize-content element)))) (setf (tui-element-content element) (tui--normalize-content (tui-element-content element))) element) (defun tui--normalize-content (content) "Complementary method to `tui-normalize-element' that normalizes CONTENT for `tui-element's :content slot (see `tui-normalize-element'). Return value is always a list." (-non-nil (cond ((tui--list-content-p content) (mapcar #'tui--normalize-node content)) (content (list (tui--normalize-node content)))))) (defun tui--normalized-element-p (element) "Return whether ELEMENT content tree is in normal form (see `tui--normalize' a description)." (and (tui-element-p element) (let ((content (tui-element-content element))) (or (null content) (not (tui--list-content-p (tui-element-content element))) (and (tui--list-content-p (tui-element-content element)) (-all-p (lambda (content-item) (tui-element-p content-item)) content)))))) (defun tui--process-update-queue () "Process the update queue. Very basic now; simply apply updates until the queue is empty." (combine-after-change-calls (catch 'tui-interrupt-update-queue (let* ((tui--applying-updates t) (inhibit-read-only t) (inhibit-modification-hooks t)) (while tui--update-queue (when (input-pending-p) (throw 'tui-interrupt-update-queue nil)) (tui--apply-update (pop tui--update-queue))) (run-hooks 'tui-update-hook) (while tui--update-queue (when (input-pending-p) (throw 'tui-interrupt-update-queue nil)) (tui--apply-update (pop tui--update-queue)))))) (when (input-pending-p) ;; tui-interrupt-update-queue (message "tui-interrupt-update-queue!") (run-with-timer 0.1 nil #'tui--process-update-queue))) (defun tui--make-ref-callback (component &optional with-nil-p) "Call COMPONENT :ref callback (if defined). When WITH-NIL-P is truthy, make callback with nil as the argument rather than the component reference." (let* ((ref-value (plist-get (tui--get-props component) :ref))) (cond ((functionp ref-value) (funcall ref-value (when (not with-nil-p) component))) ((tui-ref-p ref-value) (setf (tui-ref-element ref-value) (when (not with-nil-p) component))) (ref-value (warn "Received an unexpected ref value"))))) (defun tui--apply-update (update) "Apply UPDATE to corresponding content tree." (pcase update (`(component-did-mount ,component) (tui--make-ref-callback component) (tui--funcall #'tui-component-did-mount component)) (`(mount ,child ,start ,end ,parent) (tui--mount child start end parent)) (`(insert ,item ,parent ,index) (display-warning 'tui-diff (format "INSERT-NODE %S %S %d" (tui--object-class item) (tui--object-class parent) index) :debug tui-log-buffer-name) (tui-insert-node item parent index)) (`(remove ,node) (display-warning 'tui-diff (format "REMOVE-NODE %S" (tui--object-class node)) :debug tui-log-buffer-name) (tui-remove node)) (`(replace ,old-node ,new-node) (display-warning 'tui-diff (format "RELACE-NODE %S %S" (tui--object-class old-node) (tui--object-class new-node)) :debug tui-log-buffer-name) (tui-replace-node old-node new-node)) (`(update-content ,node ,update-count ,new-content) (let* ((current-update-count (tui-node-update-count node))) (if (> current-update-count update-count) (display-warning 'tui-diff (format "UPDATE-CONTENT SKIPPED (OUTDATED) %S (%d) %S" (tui--object-class node) (tui-node-id node) new-content) :debug tui-log-buffer-name) (display-warning 'tui-diff (format "UPDATE-CONTENT %S (%d) %s" (tui--object-class node) (tui-node-id node) new-content) :debug tui-log-buffer-name) (setf (tui-node-content node) new-content) (-let* (((start . end) (tui-segment node))) (tui--insert node))))) (`(update-props ,component ,updated-props) (-let* ((old-props (tui--get-props component)) (invisible (plist-get updated-props :invisible)) (old-ref (plist-get old-props :ref)) (new-ref (plist-get updated-props :ref)) (ref-changed (not (equal old-ref new-ref)))) (display-warning 'tui-diff (format "UPDATE-PROPS %S" (tui--object-class component)) :debug tui-log-buffer-name) (when (and ref-changed (functionp old-ref)) (funcall old-ref nil)) (tui--set-props component updated-props) (tui--make-ref-callback component) (when (not (eq (plist-get old-props :invisible) invisible)) (if invisible (tui-hide-element component) (tui--show-element component))))) (`(update-text-props ,component ,changed-text-props) (tui--update-text-props component changed-text-props)) (`(component-did-update ,component ,new-props ,new-state) (tui--funcall #'tui-component-did-update component new-props new-state)) (_ (error "Unknown update format: %S" (first update))))) (cl-defmethod tui--split-division (node division) "" (let ((marker-list (tui-node-marker-list node))) (tui-marker-list-split-node marker-list division))) (defvar-local tui--content-trees nil "Content trees local to the current buffer") (cl-defun tui-buffer-content-trees (&optional (buffer (current-buffer))) "Return a list of the root nodes of content trees mounted within BUFFER." (buffer-local-value 'tui--content-trees buffer)) (defun tui-unmount-buffer-content-tree (tree) "Unmount content TREE within the current buffer. TREE is represented by the root node." (interactive (list (tui-dev-read-buffer-content-tree (current-buffer)))) (tui--unmount tree)) (defun tui-unmount-all-buffer-content-trees (buffer) "Unmount all content trees within BUFFER or `(current-buffer)'." (interactive (list (read-buffer "Unmount all tui content trees in buffer: "))) (let* ((trees (tui-buffer-content-trees buffer))) (when (or (not (called-interactively-p 'interactive)) (and (> (length trees) 0) (y-or-n-p (format "Unmount %d content trees in %s? " (length trees) (buffer-name buffer))))) (mapcar #'tui-unmount-buffer-content-tree trees) (setq tui--content-trees nil) t))) (defun tui-unmount-current-buffer-content-trees () "Unmount all content trees in the current buffer." (interactive) (tui-unmount-all-buffer-content-trees (current-buffer))) (defun tui--updated-buffers () "Return a list of buffers that have been marked as modified." (-filter (lambda (buffer) (buffer-local-value 'tui--buffer-modified-p buffer)) (buffer-list))) (cl-defun tui--mark-buffer-clean (&optional (buffer (current-buffer))) "Reset the `tui--buffer-modified-p' flag on BUFFER." (setf (buffer-local-value 'tui--buffer-modified-p buffer) nil)) ;; (cl-defmethod tui--mark-subtree-dirty ((node tui-node)) ;; "" ;; (let* ((nodes (list node))) ;; (while nodes ;; (let* ((node (pop nodes)) ;; (children (tui-child-nodes node))) ;; (when children ;; (push children nodes)) ;; (setf (tui-node-dirty-p node) t))))) ;; (defmacro tui--mark-clean (node) ;; "Mark NODE clean." ;; `(setf (tui-node-dirty-p ,node) nil)) ;; (cl-defmethod tui--dirty-subtrees ((node tui-node)) ;; "Return a list of descendents of NODE that require re-rendering." ;; ) (defun tui--check-key-value-documentation (documentation) "Internal function to check the form of DOCUMENTATION." (cl-loop for (prop-keyword docstring) on documentation by #'cddr if (not (keywordp prop-keyword)) do (warn "Malformed documentation list"))) (provide 'tui-core) ;;; tui-core.el ends here ================================================ FILE: tui-defun.el ================================================ (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-core) (defmacro tui-defun (name props docstring &rest body) "Foundational macro to enable algebraic effects for tui components." (declare (indent defun)) `(tui-define-component ,name :documentation ,docstring :render (lambda (_) (tui-let (&props ,@props) ,@body)))) (cl-defmacro tui-defun-1 (name (this) docstring &rest body) "" `(tui-defun-2 ,name (&this ,this) ,docstring ,@body)) (defun tui-defun-2--group-arguments (arguments) "Separate ARGUMENTS into (THIS PROPS STATE)." (cl-loop with group = '&props for arg in arguments if (member arg '(&this &state)) do (setq group arg) else if (eq group '&props) collect arg into props else if (eq group '&this) collect arg into this else if (eq group '&state) collect arg into state end finally return (list this props state))) ;; (tui-defun-2--group-arguments '(foo &this this &state bar)) ;; ((this) (foo) (bar)) (defun tui--symbol-to-keyword (symbol) (intern (concat ":" (symbol-name symbol)))) (cl-defmacro tui--with-prop-state-bindings ((this-sym prop-symbols state-symbols) &rest body) "Bind PROP-SYMBOLS and STATE-SYMBOLS in their respective orders with values retrieved from component THIS-SYM and evalueate BODY. Return the last value of BODY." (declare (indent defun)) (let* ((props-sym (make-symbol "props")) (state-sym (make-symbol "state"))) `(let* (,@(when prop-symbols `((,props-sym (tui-component-props ,this-sym)) ,@(--map (list it `(plist-get ,props-sym ,(tui--symbol-to-keyword it))) prop-symbols))) ,@(when state-symbols `((,state-sym (tui-component-state ,this-sym)) ,@(--map (list it `(plist-get ,state-sym ,(tui--symbol-to-keyword it))) state-symbols)))) ,@body))) (defmacro tui-defun-2 (name arguments docstring &rest body) "Syntactic sugar for tersely defining a tui component with NAME. ARGUMENTS should be a list of the form (PROP-1 PROP-2 ... &this THIS &state STATE-1 STATE-2 ...). BODY is evaluated on each render. Documentation string DOCSTRING." (declare (indent defun) (wip TODO "Clarify behavior of initial prop values vs get default props w/terse defaults signature")) (cl-flet ((normalize-varlists (varlist) (--map (if (consp it) it (list it nil)) varlist))) (-let* (((this props state) (tui-defun-2--group-arguments arguments)) (this-sym (or (car this) (make-symbol "this"))) (prop-alist (normalize-varlists props)) (prop-keys (mapcar #'car prop-alist)) (state-alist (normalize-varlists state)) (state-keys (mapcar #'car state-alist))) `(tui-define-component ,name :documentation ,docstring ,@(when (-non-nil (-filter #'cadr prop-alist)) (list :get-default-props `(lambda () (-let* ,prop-alist (list ,@(apply #'append (--map (list (tui--symbol-to-keyword it) it) prop-keys))))))) ,@(when (-non-nil (-filter #'cadr state-alist)) (list :get-initial-state `(lambda (,this-sym) (tui--with-prop-state-bindings (,this-sym ,prop-keys nil) (-let* ,state-alist (list ,@(apply #'append (--map (list (tui--symbol-to-keyword it) it) state-keys)))))))) :render (lambda (,this-sym) (tui--with-prop-state-bindings (,this-sym ,prop-keys ,state-keys) ,@body)))))) (provide 'tui-defun) ================================================ FILE: tui-demos.el ================================================ (require 'tui-tic-tac-toe "demo/tui-tic-tac-toe.el") (provide 'tui-demos) ================================================ FILE: tui-dev.el ================================================ ;;; tui-dev.el --- Developer helper functions -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'tui-core) (require 'tui-defun) ;;; Code: (defvar tui-dev-keymap (let ((map (make-sparse-keymap))) (define-key map "d" #'tui-show-basic-element-outline) map) "Developer commands for tui.") (define-minor-mode tui-dev-mode "Handy functions for tui development." nil nil tui-dev-keymap) (defun tui-blink-component (component) "Blink COMPONENT to help visually locate it." ;; TODO: (run-at-time "1 sec" nil ) ;; add and then remove box face ) (tui-defun tui-element-outline (element) "Structure outline of ELEMENT and its children." ;; TODO: use tree component (tui-element-outline-string element)) (cl-defun tui-element-outline-string (element &optional (depth 0)) "Return a string describing the structure of ELEMENT. Indent string according to DEPTH." (interactive) (let ((prefix (make-string (* 2 depth) ? ))) (if (null element) (format "%s nil" prefix) (unless (tui--object-of-class-p element 'tui-node) (error "Expecting a tui-node object")) (-let* ((content (tui-node-content element)) ((start . end) (tui-segment element))) (cond ((tui-element-p element) (progn (format "%s%S (element %S) (%S,%S)\n%s" prefix (tui--type element) (tui-element-id element) start end (mapconcat (lambda (content-item) (tui-element-outline-string content-item (+ 1 depth))) content "\n")))) ((tui--object-of-class-p element 'tui-text-node) (format "%s%S (text-node) (%S,%S)" prefix content start end)) (t (format "%s%S %S (%S,%S)" prefix (tui--type element) content start end))))))) (cl-defun tui-show-basic-element-outline ((node (tui-root-node (point)))) "Show an outline representation of NODE for debugging purposes." (interactive) (let ((buffer (get-buffer-create "*Tui Tree*"))) (save-current-buffer (with-current-buffer buffer (erase-buffer) (insert (tui-element-outline-string (tui-root-node node))) (switch-to-buffer-other-window buffer))))) (defun tui-show-element-outline (&optional node) "Show a an interactive outline representation of NODE." (interactive) (tui-render-with-buffer "*tui-show-element-outline*" (tui-element-outline-string node))) (cl-defun tui-read-type (&optional (prompt "Type: ") (options (tui-all-component-types)) &key hide-tui-builtins) "Return a user-selected type as a symbol. Optionally override PROMPT string. Optionally limit types to OPTIONS." (declare (wip TODO "Enable toggling of builtin filtering" TODO "Refine mechanism of tracking 'builtin'")) (when hide-tui-builtins (setq options (--filter (not (tui-builtin-component-type-p it)) options))) (intern (completing-read "Type: " options nil t))) (cl-defun tui-read-type-at-point (&key (prompt "Type: ") (hide-tui-builtins t)) "Return a component type present at point. Optionally hide built-in tui.el types when HIDE-TUI-BUILTINS is non-nil (the default)." (tui-read-type prompt (or (mapcar (lambda (element) (tui--object-class element)) (tui-ancestor-elements-at (point))) (tui-all-component-types)) :hide-tui-builtins hide-tui-builtins)) (defun tui-find-definition (type) "Find the definition of tui component TYPE or an element at point." (interactive (list (tui-read-type-at-point))) (tui-find-component type)) (defun tui-find-component (type) "Find the definition of tui component TYPE." (interactive (list (tui-read-type))) (let* ((type-name (symbol-name type))) (find-function (intern (s-chop-prefix "cl-struct-" type-name))))) (put 'tui-wip 'invisible t) (defun tui-toggle-wip () "Hide/show ``work in progress'' UI elements." (interactive) (if (get 'tui-wip 'invisible) (put 'tui-wip 'invisible nil) (put 'tui-wip 'invisible t))) (defun tui-dev-reset () "Try resetting some things in case the tui engine is behaving badly." (interactive) ;; In case of user tampering: (setq tui--applying-updates nil) ;; Disregard unprocessed updates (setq tui--update-queue nil) (mapcar #'tui--mark-buffer-clean (tui--updated-buffers))) (tui-defun tui-dev-content-tree-short-summary (tree) "Single-line summary describing content TREE." (list (tui-node-label tree) (if (tui-mounted-p tree) (list " at " (tui-link :target (tui-start tree) (prin1-to-string (tui-start tree)))) " not mounted"))) (cl-defun tui-dev-list-content-trees (&optional (buffer (current-buffer))) "Return a list of all content trees in BUFFER." (interactive) (tui-render-with-buffer "*tui-dev-list-content-trees*" (--map (tui-line (tui-dev-content-tree-short-summary :tree it)) (tui-buffer-content-trees)))) (cl-defun tui-read-buffer-content-tree (&optional (buffer (current-buffer)) (prompt "Content Tree: ")) "Return a user-selected content tree within BUFFER. Optionally override PROMPT string." (let* ((options (--map (cons (tui-render-to-string (tui-dev-content-tree-short-summary :tree it)) it) (tui-buffer-content-trees buffer)))) (assoc-default (completing-read prompt options) options))) (provide 'tui-dev) ;;; tui-dev.el ends here ================================================ FILE: tui-dom.el ================================================ ;;; tui-dom.el --- Tui "DOM" logic -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-node-types) (cl-defmethod tui-append-child ((parent tui-element) child) "Add CHILD to end of the list of PARENT element's children." (let ((content (tui-element-content parent))) (tui-insert-node child parent (length content)))) (defun tui-insert-node (node parent index) "Insert NODE as a child of PARENT at INDEX. In case NODE is already mounted, this function removes NODE from existing parent and moves it to new location in PARENT. Returns NODE." (cl-assert (tui-element-p parent) t "Nodes can only be inserted into elements.") (unless (tui-node-p node) (setq node (tui--normalize-node node))) (if (tui-node-mounted node) ;; TODO: special case with unmounted NODE, but with parent `(tui-parent node)' (tui-move-subtree node parent index) (-let* ((content (tui-element-content parent)) (target-division (car (tui--separating-divisions parent index))) ((target-start target-end) (cl-rest (tui-marker-list-split-node (tui-node-marker-list parent) target-division 2)))) ;; (if (eq node node-after-target) ;; (display-warning 'tui (format "Node %S already at index %d" (tui--object-class node) index) :debug tui-log-buffer-name) (cl-assert (not (null target-division)) t "Target marker for insertion not found.") (setf (tui-element-content parent) (-insert-at index node content)) (tui--update-node-index-positions (tui-child-nodes parent)) (tui--mount node target-start target-end parent))) (unless tui--applying-updates (tui--process-update-queue)) node) (defun tui--separating-divisions (element index) "Internal function. Return pair of divisions within ELEMENT at INDEX corresponding to be used for inserting content at INDEX." (let* ((content (tui-element-content element)) (content-length (length content))) (cond ((eq content-length 0) (cons (tui--start-division element) (tui--end-division element))) ((eq index 0) (cons (tui--start-division element) (tui--start-division (cl-first content)))) ((< index content-length) (cons (tui--end-division (nth (- index 1) content)) (tui--start-division (nth index content)))) ((= index content-length) (cons (tui--end-division (-last-item content)) (tui--end-division element))) (t (error "Invalid index"))))) (defun tui-replace-node (old-node new-node) "Relaces OLD-NODE with NEW-NODE in its content tree." (let ((parent (tui-parent old-node)) (target-index (tui-node-relative-index old-node))) (tui-remove-child parent old-node ) (tui-insert-node new-node parent target-index))) (cl-defmethod tui-replace-with ((old-child tui-node) new-child) "Replace OLD-CHILD node with NEW-CHILD node." (cl-assert (tui-parent old-child) t "Target must be a child node.") (tui-replace-node old-child new-child)) (defun tui-remove (node) "Remove NODE from its current tree position." (tui--unmount node)) (defun tui-remove-child (node child) "Remove CHILD node of NODE." (cl-assert (eq (tui-parent child) node) t "Node is not a child of specified node.") (tui-remove child)) (defun tui-root-node (&optional thing) "Return the root node of the tree that THING is part of." (unless (tui-node-p thing) (setq thing (tui-get-node-at (point)))) (if (tui-root-node-p thing) thing (-last-item (tui-ancestor-elements thing)))) (defun tui-root-node-p (node) "Return t if NODE is the root element of its content tree." (not (tui-parent node))) (cl-defmethod tui-child-nodes (obj) "Return nil. List of child nodes of OBJ (a non-tui object) is nil." nil) (cl-defmethod tui-child-nodes ((node tui-node)) "Return a list of child nodes of NODE." nil) (cl-defmethod tui-child-nodes ((element tui-element)) "Return a list of child nodes of NODE." (tui-element-content element)) (cl-defmethod tui-visible-child-nodes ((node tui-node)) "Return a list of child nodes of NODE." (when (tui-element-p node) (-filter (lambda (child) (and child (not (tui-invisible-p child)))) (tui-node-content node)))) (defun tui-descendent-nodes (node) "Return all descendent nodes of NODE." (apply #'append (mapcar (lambda (child) (cons child (tui-descendent-nodes child))) (tui-child-nodes node)))) (defun tui--make-root-node (node) "Internal function to initialize NODE as a proper root node." (let ((node (tui--normalize-node node))) (setf (tui-node-marker-list node) (tui-marker-list-create)) node)) (defvar tui--element-parent-table (make-hash-table :weakness 'key) "Parent element lookup table.") (defun tui-ancestor-elements-at (&optional pos type) "Get a list of comp elements at POS. The root element is last. Filter returned elements according to TYPE. All ancestors are returned when TYPE is nil." ;; CLEANUP: reconcile tui-ancestor-elements-at and tui-ancestor-elements? (confusing otherwise) (-when-let* ((element (tui-get-element-at pos))) (-filter (if type (-rpartial #'tui--object-of-class-p type) #'identity) (cons element (tui-ancestor-elements element))))) (defun tui-ancestor-elements (node &optional type) "Return ancestor elements of NODE with the root node last. Filter returned elements according to TYPE. All ancestors are returned when TYPE is nil." (when node (-when-let* ((parent-ancestry (gethash node tui--element-parent-table))) (if type (-filter (-rpartial #'tui--object-of-class-p type) parent-ancestry) parent-ancestry)))) (defun tui-parent (node &optional type) "Return the first ancestor element of NODE matching TYPE. Returns nil if NODE is a root node or has no ancestors matching TYPE." (let ((ancestor-elements (tui-ancestor-elements node))) (if type (-first (-rpartial #'tui--object-of-class-p type) (cdr ancestor-elements)) (cadr ancestor-elements)))) (defun tui--set-parent (node parent &optional marker-list) "Internal function to set the parent element of NODE to PARENT. MARKER-LIST may be passed when mounting child elements in an alternate buffer." (let* ((parent-ancestry (tui-ancestor-elements parent)) (ancestry (gethash node tui--element-parent-table))) (when (or parent marker-list) (setf (tui-node-marker-list node) (or marker-list (tui-element-marker-list parent)))) (if ancestry (setcdr ancestry parent-ancestry) (puthash node (cons node parent-ancestry) tui--element-parent-table)))) (defun tui-move-subtree (node parent index) "Move subtree rooted at NODE to INDEX position within PARENT. Returns NODE." (display-warning 'tui (format "MOVE-SUBTREE %S to position %d in %S" (tui--object-class node) index (tui--object-class parent)) :debug tui-log-buffer-name) (-let* ((current-parent (tui-parent node)) (current-index (tui-node-relative-index node)) (new-parent parent) (content (tui-element-content parent)) (marker-list (tui-node-marker-list node))) (if (and (eq current-parent new-parent) (eq (nth index content) node)) (display-warning 'tui (format "Node %S already at target location" (tui--object-class node)) :debug tui-log-buffer-name) (-let* (((target-start . target-end) (tui--separating-divisions parent index)) (source-start (tui-marker-list-node-previous (tui--start-division node))) (source-end (tui-marker-list-node-next (tui--end-division node)))) ;; Remove node from current parent (when current-parent (setf (tui-element-content current-parent) (remove node (tui-element-content current-parent)))) ;; Insert node as child of parent (tui--set-parent node new-parent) (setf (tui-element-content new-parent) (-insert-at (if (<= index current-index) index (- index 1)) node (tui-element-content new-parent))) (tui--update-node-index-positions (tui-child-nodes new-parent)) ;; Move node markers (tui-marker-list-move-segment marker-list source-start source-end target-start target-end) ;; TODO: restore this ;; (tui--apply-inherited-text-props (tui-start node) (tui-end node) parent) )) node)) (defun tui--update-node-index-positions (nodes) "Update cached node positions on or after INDEX in NODES list by adding OFFSET to their index position." (-map-indexed (lambda (item-index item) (setf (tui-node-relative-index item) item-index)) nodes)) (defun tui-ancestor-p (parent node) "Return t if PARENT is a parent node of NODE." (and (tui-element-p parent) (cl-position parent (tui-ancestor-elements node)) t)) (defun tui--relative-tree-position (a b) "Return the relative position of nodes A and B within the content tree. Returns -1 if A is left of B, 1 if A is right of B, and 0 if one is a parent of the other. Signals an error if A and B are not in the same content tree." (tui--relative-position (tui-index-position a) (tui-index-position b))) (defun tui-lowest-common-ancestor (node-a node-b) "Return the lowest common ancestor node of NODE-A and NODE-B. Returns nil if NODE-A and NODE-B reside in distinct content trees." (let* ((ancestors-a (tui-ancestor-elements node-a)) (ancestors-b (tui-ancestor-elements node-b)) (-compare-fn #'eq)) (cl-loop for ancestor-a in ancestors-a for common = (-contains-p ancestors-b ancestor-a) until common finally return ancestor-a))) (defun tui-precedes-p (a b) "Return t if A precedes B within the content tree (depth-first traversal). Nodes do not precede or follow any of their ancestor elements." (or (< (tui-end a) (tui-start b)) (and (= (tui-end a) (tui-start b)) (tui--position-precedes (tui-index-position a) (tui-index-position b))))) (defun tui--position-precedes (position-a position-b) "Return t if POSITION-A precedes POSITION-B." (cl-loop for a in position-a for b in position-b if (< a b) return t if (> a b) return nil finally return nil)) (defun tui--relative-position (position-a position-b) "Comparator of tree list-based tree positions POSITION-A and POSITION-B. Returns -1 if POSITION-A precedes POSITION-B, 1 if POSITION-B precedes POSITION-A, and 0 if one is position-a parent of the other." (cl-loop for position-a in position-a for position-b in position-b if (< position-a position-b) return -1 if (> position-a position-b) return 1 finally return 0)) (defun tui-follows-p (a b) "Return t if A follows B in terms in the content tree. Nodes do not precede or follow any of their ancestor elements." (tui-precedes-p b a)) (defun tui-encloses-p (thing part) "Return t if THING fully encloses PART. Returns nil if either THING or PART shares a boundary and is represented by a point or marker. Markers are ambiguous; without an element context, coincident markers cannot be compared." (cond ((consp thing) (-when-let* (((thing-start . thing-end) thing)) (and (tui-precedes-p thing-start part) (tui-follows-p thing-end part)))) ((tui-node-p thing) (if (tui-node-p part) (tui-ancestor-p thing part) (-let* (((thing-start . thing-end) (tui-segment thing))) (or (and (number-or-marker-p part) (< part thing-start) (> part thing-end)) (and (consp part) (-when-let* (((part-start . part-end) part)) (and (number-or-marker-p part-start) (< part-start thing-start) (> part-start thing-end) (number-or-marker-p part-end) (< part-end thing-start) (> part-end thing-end)))))))))) (defun tui-overlaps-p (a b) "Return t if segments represented by A and B overlap in any way. A and B overlap, for example, if one is a parent of the other. Coincident points/markers don't count." (or (< (tui-end a) (tui-start b)) (and (= (tui-end a) (tui-start b)) (tui--position-coincides (tui-index-position a) (tui-index-position b))))) (defun tui--position-coincides (position-a position-b) "Return t if POSITION-A coincides with POSITION-B (one is a parent of the other)." (cl-loop for a in position-a for b in position-b if (< a b) return nil if (> a b) return nil finally return t)) (cl-defmethod tui-index-position ((node tui-node)) "Return the index position of NODE within its content tree." (cl-rest (reverse (mapcar (lambda (node) (tui-node-relative-index node)) (gethash node tui--element-parent-table))))) (cl-defmethod tui-index-position-string ((node tui-node)) "Return the index position of NODE within its content tree as a string (ex: '1.0.2.3')." (s-join "." (tui-index-position node))) (provide 'tui-dom) ;;; tui-dom.el ends here ================================================ FILE: tui-errors.el ================================================ (defmacro tui-with-content-reported-error (body) "Helper for trapping and reporting errors inline as an element." `(condition-case err ,body (t (tui-span :text-props-push `(help-echo ,(prin1-to-string err)) "(error)")))) (provide 'tui-errors) ================================================ FILE: tui-hooks.el ================================================ ;; -*- lexical-binding: t -*- (require 'tui) (require 'cl-lib) (cl-defstruct (tui-hooks--dependencies-reference (:constructor tui-hooks--dependencies-reference-create) (:copier nil)) current dependencies) (cl-defstruct (tui-hooks--effect-reference (:constructor tui-hooks--effect-reference-create) (:copier nil) (:include tui-hooks--dependencies-reference))) (cl-defstruct (tui-hooks--cursor (:constructor tui-hooks--cursor-create) (:copier nil)) component index) ;; (tui-hooks--replace-and-pad-if-needed 0 "my-ref" '()) ;; (tui-hooks--replace-and-pad-if-needed 1 "my-ref" '()) ;; (tui-hooks--replace-and-pad-if-needed 0 "my-ref" '("old-ref")) ;; (tui-hooks--replace-and-pad-if-needed 1 "my-ref" '("front-ref" "to-be-replaced" "old-ref")) (defun tui-hooks--replace-and-pad-if-needed (idx ref ls) (declare (pure t)) "Replace ref in list for position idx, padding if needed" (let ((idx-relative-to-head (- idx (length ls)))) (if (wholenump idx-relative-to-head) (append (list ref) (make-list idx-relative-to-head nil) ls) (append (cl-subseq ls 0 (- -1 idx-relative-to-head)) (list ref) (cl-subseq ls (- idx-relative-to-head)))))) (defun tui-hooks--ref-or-ref-producer (ref-or-ref-producer) (if (and (functionp ref-or-ref-producer) (eq 0 (cdr (func-arity ref-or-ref-producer)))) (funcall ref-or-ref-producer) ref-or-ref-producer)) ;; restart hook state before render (cl-defmethod tui-render :before ((component tui-component)) (tui--set-state component (list :tui-hooks--cursor (tui-hooks--cursor-create :component component :index 0)) t)) ;; teardown for effects (cl-defmethod tui-component-will-unmount :after ((component tui-component)) (let* ((references (plist-get (tui-get-state component) :tui-hooks--references))) (cl-loop for ref in references when (tui-hooks--effect-reference-p ref) do (let ((maybe-teardown-func (tui-hooks--effect-reference-current ref))) (if (functionp maybe-teardown-func) (funcall maybe-teardown-func)))))) (defun tui-hooks--cursor-advance (component) "Statefully return the current tui-hooks--state for the component. Useful hooks _must_ call this a _consistent_ number of times. This is a stable cursor that can be used to get and set references at any point during the lifetime of the component" (let* ((cursor (or (plist-get (tui-get-state component) :tui-hooks--cursor) (tui-hooks--cursor-create :component component :index 0))) (next-cursor (tui-hooks--cursor-create :component component :index (1+ (tui-hooks--cursor-index cursor))))) (tui--set-state component (list :tui-hooks--cursor next-cursor) t) cursor)) (defun tui-hooks--cursor-get (cursor) "Return the current reference" (let* ((cursor-idx (tui-hooks--cursor-index cursor)) (component (tui-hooks--cursor-component cursor)) (references (plist-get (tui-get-state component) :tui-hooks--references)) ;; we assign these in reverse order ;; 0 is first added, so last in list ;; 1 is next-to-last (idx (- (length references) 1 cursor-idx))) (when (wholenump idx) (nth idx references)))) (defun tui-hooks--cursor-set (cursor reference &optional no-update) "Set the reference at cursor position. Can be called throughout the lifetime of the component" (let* ((cursor-idx (tui-hooks--cursor-index cursor)) (component (tui-hooks--cursor-component cursor)) (update-state (lambda () (tui--set-state component (lambda (prev-component-state) (let* ((prev-references (plist-get prev-component-state :tui-hooks--references)) (updated-references (tui-hooks--replace-and-pad-if-needed cursor-idx reference prev-references))) (list :tui-hooks--references updated-references))) no-update)))) (if no-update (funcall update-state) ;; we wrap the set state call in a run-at-time to post it ;; so that the reconciler has the opportunity to diff (run-at-time 0 nil update-state)))) ;; public API below (defun tui-use-effect (component dependencies effect) "Executes the effect, deferring clean up until dependencies change or the component is unmounted" (let* ((hook-state (tui-hooks--cursor-advance component)) (prev-state (tui-hooks--cursor-get hook-state)) (invoke-and-update (lambda () (tui-hooks--cursor-set hook-state (tui-hooks--effect-reference-create :current (funcall effect) :dependencies dependencies) t)))) (if (not prev-state) (funcall invoke-and-update) (cl-assert (cl-typep prev-state 'tui-hooks--effect-reference)) (let ((prev-dependencies (tui-hooks--effect-reference-dependencies prev-state))) (unless (equal dependencies prev-dependencies) (let ((prev-effect-teardown (tui-hooks--effect-reference-current prev-state))) (if (functionp prev-effect-teardown) (funcall prev-effect-teardown))) (funcall invoke-and-update)))))) (defun tui-use-state (component state) (let* ((cursor (tui-hooks--cursor-advance component)) (curr-state (or (tui-hooks--cursor-get cursor) (progn (tui-hooks--cursor-set cursor state t) state))) (state-updater (tui-use-callback component cursor (lambda (next-state-or-updater) (let ((next-state (if (functionp next-state-or-updater) (funcall next-state-or-updater (tui-hooks--cursor-get cursor)) next-state-or-updater))) (tui-hooks--cursor-set cursor next-state)))))) (list curr-state state-updater))) (defun tui-use-ref (component ref-or-ref-producer) (let* ((hook-state (tui-hooks--cursor-advance component)) (curr-state (tui-hooks--cursor-get hook-state))) (or curr-state (let ((ref (tui-hooks--ref-or-ref-producer ref-or-ref-producer))) (tui-hooks--cursor-set curr-state ref) ref)))) (defun tui-use-memo (component dependencies ref-or-ref-producer) (let* ((hook-state (tui-hooks--cursor-advance component)) (curr-reference (tui-hooks--cursor-get hook-state))) (if (or (not curr-reference) (not (equal (tui-hooks--dependencies-reference-dependencies curr-reference) dependencies))) (let ((next-reference (tui-hooks--ref-or-ref-producer ref-or-ref-producer))) ;; don't update: no need for a re-render we're returning the new value synchronously (tui-hooks--cursor-set hook-state (tui-hooks--dependencies-reference-create :current next-reference :dependencies dependencies) t) next-reference) (tui-hooks--dependencies-reference-current curr-reference)))) (defun tui-use-callback (component dependencies callback) (tui-use-memo component dependencies (lambda () callback))) (provide 'tui-hooks) ================================================ FILE: tui-html.el ================================================ (defvar tui-type-to-html-tag-mapping '((tui-div . div) (tui-span . span)) "Alist of mappings from tui types to html tags.") (defun tui-node-to-html-sexp (node) "Convert NODE to HTML s-expressions." (if (stringp node) node (let* ((type (tui--type node))) (apply #'list (or (assoc-default type tui-type-to-html-tag-mapping) type) nil (mapcar #'tui-node-to-html-sexp (plist-get (tui-element-props node) :children)))))) (defun tui--sexp-to-html-string (sexp) "Encode HTML SEXP as an HTML string." (cond ((null sexp) "") ((stringp sexp) sexp) ((listp sexp) (let* ((tag (symbol-name (car sexp)))) (format "<%s>%s" tag (mapconcat #'tui--sexp-to-html-string (cddr sexp) "") tag))))) (defun tui-node-to-html-string (node) "" (tui--sexp-to-html-string (tui-node-to-html-sexp node))) ;; (tui-node-to-html-string ;tui-node-to-html-sexp ;; (tui-div ;; (tui-span "Hello, world!"))) ;; "
Hello, world!
" ;; (div nil (span nil "Hello, world!")) ;; (tui-element-content ;; (tui-span "Hello, world!")) ;; (div nil nil) (defun my/lib-libxml-parse-html-string (str) "Convenience function for parsing an HTML string STR." (with-temp-buffer (insert str) (libxml-parse-html-region (point-min) (point-max)))) ;; (my/lib-libxml-parse-html-string "
Hello, world!
") ;; (html nil (body nil (div nil "Hello, world!"))) (provide 'tui-html) ================================================ FILE: tui-inspect.el ================================================ ;;; tui-inspect.el --- Tools for inspecting tui content -*- lexical-binding: t; -*- ;;; Commentary: ;; (require 'dash) (require 'tui-components) (defun tui-describe-element (element) "Show information about ELEMENT." (interactive (list (tui-read-element-at-point))) (list (tui-heading (tui-node-label element)) (tui-line "instances: " "[not indexed]"))) (defun tui-element-summary-show (element) "Render RENDER-FN-SYMBOL to a dedicated buffer and return that buffer." (interactive (list (tui-read-element-at-point))) (-let* ((buffer-name (format "*tui-element-summary: %s*" (cl-prin1-to-string element)))) (tui-render-with-buffer buffer-name (tui-element-summary :element element)))) (provide 'tui-inspect) ;;; tui-inspect.el ends here ================================================ FILE: tui-layout.el ================================================ ;;; tui-layout.el --- Layout / Visibility Helpers -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-dom) (defun tui-get-node-at (&optional pos type) "Get the `tui-node' at POS. Search ancestors for a node of type TYPE when TYPE is non-nil." (unless pos (setq pos (point))) (if type (cl-first (tui-ancestor-elements-at pos type)) (get-text-property pos 'tui-node))) (defun tui-get-element-at (&optional pos type) "Get the `tui-element' at POS. Search ancestors for element of type TYPE when TYPE is non-nil." (unless pos (setq pos (point))) (if type (cl-first (tui-ancestor-elements-at pos type)) (tui-parent (get-text-property pos 'tui-node)))) (cl-defmethod tui--get-string ((node tui-node)) "Return the string representation of NODE's content tree. Return nil if NODE is not mounted." (-when-let* ((start (tui-start node)) (end (tui-end node))) (with-current-buffer (marker-buffer start) (buffer-substring start end)))) (cl-defmethod tui--get-string (content) "Return the string representation of CONTENT." (if (tui--list-content-p content) (mapconcat #'tui--get-string content) (cond ((null content) "") ((stringp content) content) ((tui--image-p content) (propertize "[image]" 'display content)) ((numberp content) (format "%s" content)) (t tui-error-placeholder-string)))) (defun tui-invisible-p (element) "Return t if ELEMENT has been marked invisible." (and (tui-element-p element) (tui-element-invisible element))) ;; (defun tui-visible-p (element) ;; "Return t if ELEMENT is not marked invisible. This does not ;; indicate that ELEMENT is in fact visible. A parent element may ;; be marked invisible which would cause ELEMENT to not be visible ;; to the user even if ELEMENT is not marked invisible." ;; (and (tui-element-p element) ;; (not (oref element :invisible)))) ;;; Segment-related (defvar tui--marker-node-table (make-hash-table :test #'eq) ;; TODO restore :weakness 'key) "Keep track of elements that start and end at markers. Values are formatted as cons cells (START-ELEMENTS . END-ELEMENTS).") (cl-defmethod tui-segment ((node tui-node)) "Return markers denoting the start and end of NODE formatted as a cons cell (START . END)." (cons (tui-marker-list-node-marker (tui-node-start node)) (tui-marker-list-node-marker (tui-node-end node)))) (cl-defmethod tui-segment--nodes ((node tui-node)) "Return marker nodes denoting the start and end of NODE formatted as a cons cell (START . END)." (cons (tui-node-start node) (tui-node-end node))) (defmacro tui--with-open-node (node &rest body) "\"Open\" segment of NODE and execute BODY. Ensure that markers are consolidated following evaluation of BODY." (declare (indent defun)) `;; (save-current-buffer ;; (save-excursion (-let* ((node ,node)) (tui--open-segment node) (tui--goto (tui-start node)) (progn . ,body))) (cl-defmethod tui--open-segment ((node tui-node)) "Return the segment for NODE formatted as a cons cell (START . END)." (-let* ((start (tui-node-start node)) (end (tui-node-end node))) (cl-assert (tui-marker-list-node-p start) "Start of segment must be a tui-marker-list-node.") (cl-assert (tui-marker-list-node-p end) "End of segment must be a tui-marker-list-node.") (tui-marker-list-open-segment (tui-node-marker-list node) start end))) (defun tui-start (node) "Return a marker denoting the start of NODE. Returns nil if NODE is not mounted." ;; TODO: defensively return copies of markers? (when (tui-node-mounted node) (tui-marker-list-node-marker (tui-node-start node)))) (defun tui-end (node) "Return a marker denoting the end of NODE. Returns nil if NODE is not mounted." ;; TODO: defensively return copies of markers? (when (tui-node-mounted node) (tui-marker-list-node-marker (tui-node-end node)))) (defun tui--start-division (node) "Return division denoting the start of NODE." (tui-node-start node)) (defun tui--end-division (node) "Return division denoting the end of NODE." (tui-node-end node)) ;;;; Markers and segments (cl-defmethod tui-markers ((node tui-node)) "Return a list of unique markers associated with NODE." (-let* (((start . end) (tui-segment node))) (list (tui-marker-list-node-start start) (tui-marker-list-node-end end)))) ;; (cl-defmethod tui-markers ((element tui-element)) ;; "Return a list of unique markers within the subtree of ELEMENT." ;; (-let* (((start . end) (tui-segment element))) ;; (tui-marker-list-range (tui-element-marker-list element) start end))) ;; (cl-defmethod tui-child-markers ((element tui-element)) ;; "Return markers of NODE's children." ;; (apply #'append ;; (mapcar ;; (lambda (child) ;; (list (tui-start child) (tui-end child))) ;; (tui-child-nodes element)))) ;;;; Internal Segment-related ;; (cl-defmethod tui--set-segment ((node tui-node) start-node end-node) ;; "Set NODE buffer segment to START-NODE and END-NODE." ;; ;; (when (and start-node end-node) ;; ;; (cl-assert (<= start-node end-node) t "Segment should be ordered.")) ;; (tui--set-start node start-node) ;; (tui--set-end node end-node)) (defun tui--elements-starting-at (marker) "Return a list of nodes starting at MARKER." (car (gethash marker tui--marker-node-table))) (defun tui--incident-node-p (node pos) "Return t if NODE starts or ends at POS." (or (= (tui-start node) pos) (= (tui-end node) pos))) (cl-defmethod tui--set-markers ((node tui-node) marker) "Internal function to set all segment endpoints in the subtree of NODE to MARKER." (setf (tui-node-start node) marker) (setf (tui-node-end node) marker)) (cl-defmethod tui--set-markers ((element tui-element) marker) "Internal function to set all segment endpoints in the subtree of NODE to MARKER." (mapc (lambda (child) (tui--set-markers child marker)) (tui-child-nodes element)) (cl-call-next-method)) ;;; Measurement / size calculation (cl-defmethod tui-line-height ((element tui-element)) "Returns the total height (in lines) of ELEMENT (not just visible characters)." (-let* (((start . end) (tui-segment element))) (when (and start end) (- (line-number-at-pos end) (line-number-at-pos start))))) (defalias 'tui-height 'tui-line-height) (cl-defun tui-region-width (start end &optional no-wrap) "Returns the total width (in columns) of region." ;; TODO: invisible characters? (when (<= start end) (save-current-buffer (save-excursion (when (markerp start) (set-buffer (marker-buffer start))) (if no-wrap (apply #'max (mapcar #'length (s-split "\n" (buffer-substring start end) t))) (tui--goto start) (-let* ((min-x (current-column)) (max-x min-x)) (while (< (point) end) (end-of-visual-line) (when (<= (point) end) (setq max-x (max max-x (current-column)))) (forward-char) (when (<= (point) end) (setq min-x (min min-x (current-column))))) (- max-x min-x))))))) (cl-defmethod tui-column-width ((element tui-element) &optional no-wrap) ;; TODO: Reimplement as column-width (and alias tui-column-width to it) include "rectangular" in docstring "Returns the total width (in columns) of ELEMENT (not just visible characters)." (-let* (((start . end) (tui-segment element))) (tui-region-column-width start end no-wrap))) (defalias 'tui-width 'tui-column-width) (cl-defmethod tui-pixel-width ((element tui-element)) "Returns the total width of COMPONENT in pixels." (-let* (((start . end) (tui-segment element))) (when (and start end) (tui-segment-pixel-width start end)))) (defun tui-rendered-visible-character-width () "Width of visible characters according to `char-width'." (char-width ) ) (cl-defmethod tui-visible-width ((element tui-element)) ;; CLEANUP: Rename as "length"? "Returns the visible width (i.e. the number of characters within the segment that are *not* invisible)." (-let* (((start . end) (tui-segment element))) (tui-segment-visible-width start end))) (defun tui-segment-visible-width (start end) "Return the number of visible characters between START and END." (let ((count 0)) (with-current-buffer (marker-buffer start) (cl-loop for pos from (marker-position start) while (< pos (marker-position end)) do (when (not (invisible-p pos)) (cl-incf count))) count))) (defun tui-region-pixel-width () "Display and return the width (in pixels) of the current region." (interactive) (let ((width (tui-segment-pixel-width (region-beginning) (region-end)))) (message "%S" width) width)) (defun tui-region-pixel-height () "Display and return the height (in pixels) of the current region." (interactive) (let ((height (tui-segment-pixel-height (region-beginning) (region-end)))) (message "%S" height) height)) (defun tui-char-pixel-size (str) ;; CLEANUP: improve name "Return (WIDTH . HEIGHT) of string STR rendered at point." (let ((pos (point))) (insert str) (tui-segment-pixel-width pos (point)) (delete-region pos (point)))) (defun tui-segment-pixel-width (start end) "Calculate and return the width (in pixels) of the segment between START and END." ;; (* (- end start) ;; (window-font-width)) ;; TODO: address line spanning (save-current-buffer (save-excursion (when (markerp start) (switch-to-buffer (marker-buffer start)) (set-buffer (marker-buffer start))) ;; (save-current-buffer ;; (when (markerp start) ;; (set-window-buffer ;; (set-buffer )) ;; TODO: improve calculation (the following wasn't fully working) (-let* ((start-x (tui--window-x-pixel-position start)) (end-x (tui--window-x-pixel-position end))) (unless (tui-spans-lines-p start end) (message "Segment spans multiple lines; measured width is not accurate.")) (when (and start-x end-x) (- end-x start-x)))))) (defun tui-segment-pixel-height (start end) "Calculate and return the height (in pixels) of the segment between START and END." (save-current-buffer (save-excursion (when (markerp start) (switch-to-buffer (marker-buffer start)) (set-buffer (marker-buffer start))) ;; (save-current-buffer ;; (when (markerp start) ;; (set-window-buffer ;; (set-buffer )) ;; TODO: improve calculation (the following wasn't fully working) (-let* ((start-y (tui--window-y-pixel-position start)) (end-y (tui--window-y-pixel-position end))) (unless (tui-spans-lines-p start end) (message "Segment spans multiple lines; measured width is not accurate.")) (when (and start-y end-y) (- end-y start-y)))))) (defun tui--add-widths (a b) "Add widths A and B. A and B do not need to use the same units. When a number, the unit is assumed have a unit of characters. When a list of length 1, the unit is assumed to be pixels." (cond ((and (numberp a) (numberp b)) (+ a b)) ((and (listp a) (listp b)) (list (+ (car a) (car b)))) ((or (eq a 0) (and (listp a) (eq 0 (car a)))) b) ((or (eq b 0) (and (listp b) (eq 0 (car b)))) a) ((and (listp a) (numberp b)) (list (+ (car a) (tui--char-width-to-pixel-width b)))) ((and (listp b) (numberp a)) (list (+ (car b) (tui--char-width-to-pixel-width a)))) (t (error "Unexpected (presumably incompatible) pixel values")))) (defun tui--pixel-width-to-char-width (pixels) "Convert PIXELS to an approximate number of characters based on `window-font-width'." (when (listp pixels) (setq pixels (car pixels))) (round (/ (* 1.0 pixels) (window-font-width)))) (defun tui--char-width-to-pixel-width (columns) "Convert COLUMNS to an approximate number of pixels based on `window-font-width'." (when (listp columns) (setq columns (car columns))) (* columns (window-font-width))) (defun tui--width-difference (a b) "Return nil if A or B is nil." (when (and a b) (cond ((and (numberp a) (numberp b)) (- a b)) ((and (listp a) (listp b)) (list (- (car a) (car b)))) ((or (eq a 0) (and (listp a) (eq 0 (car a)))) b) ((or (eq b 0) (and (listp b) (eq 0 (car b)))) a) (t (error "Unexpected (presumably incompatible) pixel values"))))) (cl-defmethod tui-length ((node tui-node)) "Return the length (number of characters) of NODE including invisible characters." (-let* (((start . end) (tui-segment node))) (- end start))) (cl-defmethod tui-string-width ((node tui-node)) "Return the display length (number of characters) of NODE including invisible characters." (string-width (tui--get-string node))) (defun tui--node-height (node) "Return the height of NODE in its content tree. The root element has a height of 1." (length (tui-ancestor-elements node))) ;;; Positioning (defun tui--window-x-pixel-position (pos) "Calculate the distance of POS relative to the left edge of the screen in pixels." (car (progn (goto-char pos) ;; (unless (pos-visible-in-window-p pos) ;; (redisplay)) (or (window-absolute-pixel-position pos) (progn (redisplay) (window-absolute-pixel-position pos)))))) (defun tui--window-y-pixel-position (pos) "Calculate the distance of POS relative to the top edge of the screen in pixels." (cdr (progn (goto-char pos) ;; (unless (pos-visible-in-window-p pos) ;; (redisplay)) (or (window-absolute-pixel-position pos) (progn (redisplay) (window-absolute-pixel-position pos)))))) (defun tui-spans-lines-p (start end) "Return t if START and END buffer positions span multiple lines." (not (eq (line-number-at-pos start) (line-number-at-pos end)))) (defun tui--display-position (pos) "Goto POS and ensure that it is visible in the window." (goto-char pos) (redisplay)) (defun tui--overflow-length (start end pixel-width) "Return the number of characters that START - END segment has exceeded PIXEL-WIDTH. Returns a negative or zero number of there is no overflow." (let ((check-position end) (pixel-boundary (+ (car (window-absolute-pixel-position start)) pixel-width))) (while (and (> check-position start) (> (car (window-absolute-pixel-position check-position)) pixel-boundary)) (setq check-position (- check-position 1))) (- end check-position))) (cl-defmethod tui-goto-start ((node tui-node) &optional other-window) "Move point to the beginning of NODE." (let ((start (tui-start node))) (funcall (if other-window #'switch-to-buffer-other-window #'switch-to-buffer) (marker-buffer start)) (goto-char (marker-position start)))) (cl-defmethod tui-goto-end ((node tui-node) &optional other-window) "Move point to the end of NODE." (let ((end (tui-end node))) (funcall (if other-window #'switch-to-buffer-other-window #'switch-to-buffer) (marker-buffer end)) (goto-char (marker-position end)))) (defun tui--goto (marker) "Move point to MARKER." (when (markerp marker) (set-buffer (marker-buffer marker))) (goto-char marker)) ;;; Visibility (defun tui-hide-element (element) "Hide ELEMENT and its subtree." (interactive (list (tui-read-element-at-point "Hide element: "))) ;; OPTIMIZE: can preserve (cache) the content of the segment to potentially avoid re-render when made visible (display-warning 'tui-diff (format "HIDE %S" (tui--object-class element)) :debug tui-log-buffer-name) (setf (tui-element-invisible element) t) (-when-let* ((mounted (tui-element-mounted element)) (inhibit-read-only t) ((start . end) (tui-segment element)) (marker-tree (tui-element-marker-list element))) (delete-region start end)) ;;(tui-valid-content-tree-p element) element) (defun tui--show-element (element) "Show ELEMENT and its subtree." (setf (tui-element-invisible element) nil) (when (tui-element-mounted element) (tui--insert element)) ;;(tui-valid-content-tree-p element) element) (defmacro tui-preserve-point (node &rest body) "Evaluate BODY preserving the point position relative to start of ancestor NODE." (declare (indent defun)) (let ((node-var (make-symbol "node")) (offset-var (make-symbol "offset"))) `(let* ((,node-var ,node) (,offset-var (tui--node-internal-offset ,node-var))) ,@body (-when-let* ((start (tui-start ,node-var))) (goto-char (+ start ,offset-var)))))) (defun tui--node-internal-offset (node) "Return the relative offset between the start of ancestor NODE and point. Returns nil if NODE is not mounted or is not an ancestor element." (let* ((start (tui-start node)) (end (tui-end node))) (when (and start (eq (marker-buffer start) (current-buffer)) (>= (point) start) (<= (point) end)) (- (point) start)))) (cl-defmethod tui-next-element (&optional pos (predicate #'identity)) "Return the nearest `tui-element' that starts after POS or point. Returns nil if there are no elements following POS in the content tree. See also `tui-previous-element'." (declare (wip TODO "Revise nomenclature to be consistent with tui node types. (``tui-next-node'' instead?)")) (unless pos (setq pos (point))) (tui-next-element (tui-get-node-at pos) predicate)) (cl-defmethod tui-next-element ((node tui-node) &optional (predicate #'identity)) "" (let* ((target-node node) (current-node target-node) current-node-index parent following-siblings next-element intermediate-element) (while (and (setq parent (tui-parent current-node)) (setq current-node-index (tui-node-relative-index current-node)) (progn (setq following-siblings (-slice (tui-child-nodes parent) (+ 1 current-node-index))) (not (setq next-element (cl-some (-partial #'tui-first-subtree-node predicate) following-siblings))))) (setq current-node parent)) (or next-element intermediate-element))) (cl-defun tui-previous-element (&optional pos (predicate #'identity)) "Return the nearest `tui-element' that ends before POS. Returns nil if there are no elements preceding POS in the content tree. See also `tui-next-element'." (unless pos (setq pos (point))) (let* ((target-node (tui-get-node-at pos)) (current-node target-node) current-node-index parent preceding-siblings previous-element intermediate-element) (while (and (setq parent (tui-parent current-node)) (setq current-node-index (tui-node-relative-index current-node)) (progn (setq preceding-siblings (reverse (-take current-node-index (tui-child-nodes parent)))) (not (setq previous-element (-some (-partial #'tui-last-subtree-node predicate) preceding-siblings))))) (setq current-node parent)) (or previous-element intermediate-element))) (provide 'tui-layout) ;;; tui-layout.el ends here ================================================ FILE: tui-live-reloading.el ================================================ ;;; tui-live-reloading.el --- Live reloading and instance tracking -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (require 'dash) (require 'subr-x) (require 'tui-core) (defvar tui-live-reloading t "Update components whenever their definitions are updated.") (defvar tui--component-instance-table (make-hash-table) "Hash table for tracking object instances instances.") (defun tui--register-instance (instance) "Internal function to track INSTANCE." (let* ((class (tui--object-class instance)) (instances (or (gethash class tui--component-instance-table) (puthash class (make-hash-table :weakness 'key) tui--component-instance-table)))) (puthash instance nil instances) instance)) (defun tui-live-reloading--update-instances (component) "" (when (and tui-live-reloading (tui-component-symbol-p component)) (tui-force-update-component-instances component))) (defun tui-component-instances (class) "Return a list of live instances of CLASS." (-when-let* ((instance-table (gethash class tui--component-instance-table))) (-filter #'tui-mounted-p (hash-table-keys instance-table)))) (defun tui-force-update-component-instances (class) "Force instances of CLASS to update. Updated rendering lifecycle logic is applied." (interactive (list (tui-read-component-type))) (remhash class tui--default-props-table) (--map (when (tui-mounted-p it) (tui-force-update it)) (tui-component-instances class))) (advice-add #'tui-create-element :filter-return #'tui--register-instance) ;; (advice-remove #'tui-create-element #'tui--register-instance) (advice-add #'eval-defun :filter-return #'tui-live-reloading--update-instances) (provide 'tui-live-reloading) ;;; tui-live-reloading.el ends here ================================================ FILE: tui-log.el ================================================ ;;; tui-log.el --- Tui logging -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (require 'warnings) (setq warning-minimum-log-level :warning) (setq warning-minimum-level :warning) (defun tui-toggle-debug-log () "Switch logging level between :warning<->:debug." (interactive) (if (eq warning-minimum-log-level :debug) (progn (setq warning-minimum-log-level :warning) (setq warning-minimum-level :warning)) (setq warning-minimum-log-level :debug) (setq warning-minimum-level :debug))) (defvar tui-log-buffer-name "*Tui Log*") (provide 'tui-log) ;;; tui-log.el ends here ================================================ FILE: tui-marker-list.el ================================================ ;;; tui-marker-list.el --- Linked list structure tracking markers -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) ;;; Types ;; TODO: split cost functions? ;; TODO: split/merge hooks? ;;; Code: (cl-defstruct tui-marker-list "Object for maintaining a list of ordered markers within a tui content tree." marker-table first last) (cl-defstruct (tui-marker-list-node (:constructor nil) (:constructor tui-marker-list-node-create (marker &optional data))) "Object for tracking a marker within a tui content tree." marker data previous next) ;;; Public Methods ;;;; CRUD (defun tui-marker-list-create (&optional markers data) "Return a new marker list. List will populated with supplies MARKERS and corresponding DATA." (save-current-buffer (save-excursion (let* ((marker-list (make-tui-marker-list)) (markers (mapcar (lambda (marker) (if (numberp marker) (save-excursion (goto-char marker) (point-marker)) marker)) markers)) (table (setf (tui-marker-list-marker-table marker-list) (make-hash-table :test #'eq))) (markers (cl-stable-sort markers #'<))) (cl-loop for (marker . data) in (-zip-fill nil markers data) for node = (tui-marker-list-node-create marker data) do (tui-marker-list-node--insert-last marker-list node) (puthash marker node table)) marker-list)))) (defun tui-marker-list-marker-data (marker-list marker) "Return data associated with MARKER in MARKER-LIST." (-when-let* ((node (tui-marker-list--marker-node marker-list marker))) (tui-marker-list-node-data node))) (defun tui-marker-list-set-marker-data (marker-list marker data) "Set data associated with MARKER in MARKER-LIST to DATA." (if-let* ((node (tui-marker-list--marker-node marker-list marker))) (setf (tui-marker-list-node-data node) data) (error "Marker not found in marker list"))) (defun tui-marker-list-node--insert-first (marker-list new-node) "Insert NEW-NODE first in MARKER-LIST." ;;(cl-assert (tui-marker-list-node-p new-node)) (let ((first-node (tui-marker-list-first marker-list))) (setf (tui-marker-list-first marker-list) new-node) (if first-node (progn (setf (tui-marker-list-node-next new-node) first-node) (setf (tui-marker-list-node-previous first-node) new-node)) (setf (tui-marker-list-last marker-list) new-node) (setf (tui-marker-list-first marker-list) new-node)))) (defun tui-marker-list-node--insert-last (marker-list new-node) "Insert NEW-NODE last in MARKER-LIST." ;;(cl-assert (tui-marker-list-node-p new-node)) (let ((last-node (tui-marker-list-last marker-list))) (setf (tui-marker-list-last marker-list) new-node) (if last-node (progn (setf (tui-marker-list-node-previous new-node) last-node) (setf (tui-marker-list-node-next last-node) new-node)) (setf (tui-marker-list-last marker-list) new-node) (setf (tui-marker-list-first marker-list) new-node)))) (defun tui-marker-list-node--insert-before (marker-list new-node node) "Insert NEW-NODE before NODE in MARKER-LIST. Return NEW-NODE." ;;(cl-assert (tui-marker-list-node-p new-node)) ;;(cl-assert (tui-marker-list-node-p node)) ;; TODO: check and possibly extract from its current position in the list (let ((previous-node (tui-marker-list-node-previous node)) ;; (initial-length (tui-marker-list-length marker-list)) ) (setf (tui-marker-list-node-next new-node) node) (setf (tui-marker-list-node-previous node) new-node) (if previous-node (setf (tui-marker-list-node-next previous-node) new-node) (setf (tui-marker-list-first marker-list) new-node)) (setf (tui-marker-list-node-previous new-node) previous-node) ;;(cl-assert (= (tui-marker-list-length marker-list) (+ initial-length 1)) t "List length increases by one with an insertion.") ;;(cl-assert (tui-marker-list-valid-p marker-list) t "List is valid after an insertion.") new-node)) (defun tui-marker-list-node--insert-after (marker-list new-node node) "Insert NEW-NODE after NODE in MARKER-LIST. Return NEW-NODE." ;; (cl-assert (tui-marker-list-node-p new-node)) ;; (cl-assert (tui-marker-list-node-p node)) ;; (cl-assert (member* node (tui-marker-list--all-nodes marker-list) :test #'eq)) ;; TODO: check and possibly extract from its current position in the list (let ((next-node (tui-marker-list-node-next node)) ;; (initial-length (tui-marker-list-length marker-list)) ) (setf (tui-marker-list-node-previous new-node) node) (setf (tui-marker-list-node-next node) new-node) (if next-node (setf (tui-marker-list-node-previous next-node) new-node) (setf (tui-marker-list-last marker-list) new-node)) (setf (tui-marker-list-node-next new-node) next-node) ;;(cl-assert (= (tui-marker-list-length marker-list) (+ initial-length 1)) t "List length increases by one with an insertion.") ;;(cl-assert (tui-marker-list-valid-p marker-list) t "List is valid after an insertion.") new-node)) (defun tui-marker-list-copy (marker-list) "Return a copy of MARKER-LIST with copies of markers from MARKER-LIST." ;; TODO ;; copy dll (don't copy element lists; only the references ;; replace all nodes with copies ) (defun tui-marker-list-same-buffer-p (marker-list marker) "Return t if MARKER-LIST and MARKER refer to the same buffer. Returns nil if MARKER-LIST is empty." (let ((buffer (tui-marker-list-buffer marker-list))) (and buffer (markerp marker) (not (eq buffer (marker-buffer marker)))))) (defun tui-marker-list--resolve-new-marker (marker-list marker) "Internal helper function to resolve MARKER to a distinct marker within MARKER-LIST." (let ((buffer (tui-marker-list-buffer marker-list))) (unless (or (not buffer) (numberp marker) (eq buffer (marker-buffer marker))) (error "Marker must refer to the same buffer")) (when (numberp marker) (when (> marker (point-max)) (error "Numeric position refers to point greater than (point-max)")) (setq marker (save-current-buffer (save-excursion (when buffer (set-buffer buffer)) (goto-char marker) (point-marker))))) (when (tui-marker-list--marker-node marker-list marker) (error "Marker is already in list")) marker)) (defun tui-marker-list-insert (marker-list marker &optional data) "Insert MARKER into MARKER-LIST. Return new node containing MARKER. Set marker data to DATA." ;; TODO: generalize this position verification/transformation (let* ((buffer (tui-marker-list-buffer marker-list))) (with-current-buffer (or buffer (current-buffer)) (setq marker (tui-marker-list--resolve-new-marker marker-list marker)) (let* ((node (tui-marker-list-first marker-list))) (while (and node (> marker (tui-marker-list-node-marker node))) (when (equal (tui-marker-list-node-marker node) marker) (error "Ambiguous position; a marker at that position is already in the list. Split that one if multiple coincident markers are needed")) (setq node (tui-marker-list-node-next node))) (let ((new-node (tui-marker-list-node-create marker data))) (if node (tui-marker-list-node--insert-before marker-list new-node node) (tui-marker-list-node--insert-last marker-list new-node)) (puthash marker new-node (tui-marker-list-marker-table marker-list)) new-node))))) (defun tui-marker-list-remove (marker-list marker) "Remove MARKER from MARKER-LIST." (-if-let* ((node (tui-marker-list--marker-node marker-list marker))) (tui-marker-list-remove-node marker-list node) (error "Marker not found!"))) (defun tui-marker-list-next-marker (marker-list marker) "Return the next marker after MARKER in MARKER-LIST." (-if-let* ((node (tui-marker-list--get-single-node-at marker-list marker))) (-when-let* ((next-node (tui-marker-list-node-next node))) (tui-marker-list-node-marker next-node)) (error "Marker not found"))) (defun tui-marker-list-prev-marker (marker-list marker) "Return the marker preceding MARKER in MARKER-LIST." (-if-let* ((node (tui-marker-list--get-single-node-at marker-list marker))) (-when-let* ((next-node (tui-marker-list-node-next node))) (tui-marker-list-node-marker next-node)) (error "Marker not found"))) (defun tui-marker-list-remove-node (marker-list node) "Remove NODE from MARKER-LIST." (let ((previous (tui-marker-list-node-previous node)) (next (tui-marker-list-node-next node))) (if previous (setf (tui-marker-list-node-next previous) next) (setf (tui-marker-list-first marker-list) next)) (if next (setf (tui-marker-list-node-previous next) previous) (setf (tui-marker-list-last marker-list) previous)))) (defun tui-marker-list-markers (marker-list) "Return all markers in MARKER-LIST." (mapcar #'tui-marker-list-node-marker (tui-marker-list--all-nodes marker-list))) (defun tui-marker-list--all-nodes (marker-list) "Return an ordered list of all nodes in MARKER-LIST." (let* ((node (tui-marker-list-first marker-list)) nodes) (while node (push node nodes) (setq node (tui-marker-list-node-next node))) (reverse nodes))) (defun tui-marker-list-valid-p (marker-list) "Return t if MARKER-LIST is valid (all markers point to the same buffer and are properly ordered)." (let* ((markers (tui-marker-list-markers marker-list)) (nodes (tui-marker-list--all-nodes marker-list))) (if (null markers) t ;; an empty marker list is valid (and ;; all markers point to the same buffer (let ((buffer (marker-buffer (cl-first markers)))) (-all-p (lambda (marker) (eq (marker-buffer marker) buffer)) (cl-rest markers))) ;; markers are ordered (-reduce (lambda (a b) (and a b (<= a b) b)) markers) ;; each pair of adjacent nodes references each other (cl-loop for left in nodes for right in (cl-rest nodes) do (cl-assert (eq (tui-marker-list-node-next left) right) t "Node refers to the next node in the list") (cl-assert (eq (tui-marker-list-node-previous right) left) t "Node refers to the previous node in the list") finally return t) (not (cl-assert (null (tui-marker-list-node-previous (cl-first nodes))) t "First node has no previous node")) (not (cl-assert (null (tui-marker-list-node-next (-last-item nodes))) t "Last node has no next node")) (not (cl-assert (eq (tui-marker-list-first marker-list) (cl-first nodes)) t "List contains references to the first item")) (not (cl-assert (eq (tui-marker-list-last marker-list) (-last-item nodes)) t "List contains references to the last item")))))) (defun tui-marker-list-buffer (marker-list) "Return the buffer that MARKER-LIST refers to. Return nil if MARKER-LIST is empty." (-when-let* ((node (tui-marker-list-first marker-list))) (marker-buffer (tui-marker-list-node-marker node)))) (defun tui-marker-list-merge-nodes (marker-list left right data) "Merge adjacent LEFT and RIGHT nodes in MARKER-LIST and associating DATA with the merged node." ;; Merge into left node (let* ((next-node (tui-marker-list-node-next right))) (if next-node (setf (tui-marker-list-node-previous next-node) left) (setf (tui-marker-list-last marker-list) left)) (setf (tui-marker-list-node-next left) next-node) (setf (tui-marker-list-node-data left) data))) ;;;; Other (cl-defmethod cl-print-object ((marker-list tui-marker-list) stream) (princ "#" stream)) (cl-defmethod cl-print-object ((marker-list tui-marker-list) stream) (princ "#" stream)) (cl-defmethod cl-object-print ((marker-list tui-marker-list) stream) (princ "#" stream)) (cl-defmethod cl-print-object ((node tui-marker-list-node) stream) (princ "#" stream)) (cl-defmethod cl-print-object ((node tui-marker-list-node) stream) (princ "#" stream)) (cl-defmethod cl-object-print ((node tui-marker-list-node) stream) (princ "#" stream)) (defun tui-marker-list--get-marker (position) "Return the buffer position of POSITION possibly represented bymarker node, marker, or number." (save-current-buffer (save-excursion (cond ((tui-marker-list-node-p position) (tui-marker-list-node-marker position)) ((numberp position) (goto-char position) ;; FIXME: we need the buffer context of the marker list (point-marker)) (t position))))) (defun tui-marker-list-length (marker-list) "Return the length of MARKER-LIST." (let* ((node (tui-marker-list-first marker-list)) (n 0)) (while node (setq node (tui-marker-list-node-next node)) (setq n (+ n 1))) n)) (defalias 'tui-marker-list-size 'tui-marker-list-length) (defun tui-marker-list-markers-at (marker-list position) "Return a list of markers in MARKER-LIST at POSITION in order." (mapcar #'tui-marker-list-node-marker (tui-marker-list--nodes-at marker-list position))) (defun tui-marker-list-delete-segment (marker-list start end) "Remove START and END markers and all markers between them from MARKER-LIST." ;; TODO: destroy markers in segment? (let* ((start-node (tui-marker-list--get-single-node-at marker-list start)) (end-node (tui-marker-list--get-single-node-at marker-list end))) (tui-marker-list-delete-node-segment marker-list start-node end-node))) (defun tui-marker-list-delete-node-segment (marker-list start end) "Remove START and END marker nodes and all nodes between them from MARKER-LIST." ;; TODO: destroy markers in segment? (let* ((previous (and start (tui-marker-list-node-previous start))) (next (and end (tui-marker-list-node-previous end))) (removed-nodes (tui-marker-list-nodes-in-range marker-list start end)) (marker-table (tui-marker-list-marker-table marker-list))) (if previous (setf (tui-marker-list-node-next previous) next) (setf (tui-marker-list-first marker-list) next)) (if next (setf (tui-marker-list-node-previous next) previous) (setf (tui-marker-list-last marker-list) previous)) (mapc (lambda (node) (remhash (tui-marker-list-node-marker node) marker-table)) removed-nodes))) (cl-defmethod tui-marker-list-open-segment (marker-list start &optional end) "'Open' segment bounded by START and END markers by setting the insertion type of START marker to nil and END to t. Return as a cons (START . END). Markers in MARKER-LIST that have coincident positions with either START or END will also have their insertion types updated to maintain their ordering for insertion between START and END." (let* ((start-node (tui-marker-list--get-single-node-at marker-list start)) (end-node (tui-marker-list--get-single-node-at marker-list end))) (unless (eq (tui-marker-list-node-next start-node) end-node) (error "Segment contains nodes")) (set-marker-insertion-type (tui-marker-list-node-marker start-node) nil) (mapc (lambda (node) (set-marker-insertion-type (tui-marker-list-node-marker node) nil)) (tui-marker-list-preceding-coincident-nodes marker-list start-node)) (set-marker-insertion-type (tui-marker-list-node-marker end-node) t) (mapc (lambda (node) (set-marker-insertion-type (tui-marker-list-node-marker node) t)) (tui-marker-list-following-coincident-nodes marker-list end-node)) (cons (tui-marker-list-node-marker start-node) (tui-marker-list-node-marker end-node)))) (defun tui-marker-list-split-marker (marker-list marker &optional number) "Split MARKER in MARKER-LIST. Returns the new markers as a list retaining their list ordering. Same as `tui-marker-list-split-node', but accepts and returns markers." ;;(display-warning 'tui (format "Splitting marker %S (%S)" start (tui--object-class node)) :debug tui-log-buffer-name) (-let* ((node (tui-marker-list--get-single-node-at marker-list marker)) (nodes (tui-marker-list-split-node marker-list node number))) (mapcar #'tui-marker-list-node-marker nodes))) ;; (defun tui-marker-list-split-marker-left (marker-list marker &optional number) ;; "Split MARKER in marker list creating a new marker at the same position, but to the left of MARKER and returning the new marker. Same as `tui-marker-list-split-node-left', but accepts and returns markers." ;; (car (tui-marker-list-split-marker marker-list marker number))) (defun tui-marker-list-split-marker-right (marker-list marker &optional number) "Split MARKER in MARKER-LIST creating a new marker at the same position, but to the right of MARKER and returning the new marker. Same as `tui-marker-list-split-node-right', but accepts and returns markers." (cadr (tui-marker-list-split-marker marker-list marker number))) (defun tui-marker-list-split-node (marker-list node &optional number) ;; CLEANUP: non-recursive implementation "Split NODE in MARKER-LIST. Returns the new markers as a list retaining their list ordering. Same as `tui-marker-list-split-marker', but accepts and returns nodes." ;; OPTIMIZE: it may be possible to choose an efficient direction of split to limit the number of affected elements (unless number (setq number 1)) (let* ((split-node node) ;; (length-before-split (tui-marker-list-length marker-list)) new-nodes) (dotimes (i number) (-let* ((existing-marker (tui-marker-list-node-marker split-node)) (new-marker (copy-marker existing-marker)) (new-node (tui-marker-list-node-create new-marker))) (tui-marker-list-node--insert-after marker-list new-node split-node) (puthash new-marker new-node (tui-marker-list-marker-table marker-list)) ;;(cl-assert (tui-marker-list--nodes-adjacent-p split-node new-node) t "Adjacent split elements should be adjacent.") (push new-node new-nodes))) ;; (cl-assert (= (+ number length-before-split) (tui-marker-list-length marker-list)) t "Split should create an additional node.") (cons node new-nodes))) ;;(cl-assert (tui-marker-list-valid-p marker-list) t "List is valid after a split.") (defun tui-marker-list--nodes-adjacent-p (left right) "Return t if LEFT is immediately before RIGHT." (eq (tui-marker-list-node-next left) right)) ;; TODO: tui-marker-list-split-node-left (/right) (defun tui-marker-list-consolidate (marker-list) "Consolidate (eliminate) all redundant markers in MARKER-LIST. All coincident markers (markers with the same buffer position) are marged." ;; TODO: iterate through marker list doing (pairwise/group?) merges ) (defun tui-marker-list-move-segment (marker-list source-start source-end target-start target-end) "Move a segment of markers and content in within MARKER-LIST. Replaces target segment content with source content. Signals an error if target segment contains markers between TARGET-START and TARGET-END. Markers between SOURCE-START and SOURCE-END are relocated to preserve their relative positions within the segment. SOURCE-START and SOURCE-END markers are preserved and have nothing between them after the move." (save-excursion (with-current-buffer (tui-marker-list-buffer marker-list) (let* ((source-start-node (tui-marker-list--get-single-node-at marker-list source-start)) (source-start (tui-marker-list--get-marker source-start)) (source-end-node (tui-marker-list--get-single-node-at marker-list source-end)) (source-end (tui-marker-list--get-marker source-end)) (target-start-node (tui-marker-list--get-single-node-at marker-list target-start)) (target-start (tui-marker-list--get-marker target-start)) (target-end-node (tui-marker-list--get-single-node-at marker-list target-end)) (target-end (tui-marker-list--get-marker target-end)) (segment-length (- source-end source-start)) ;; Save marker offsets (internal-nodes (tui-marker-list-nodes-between marker-list source-start-node source-end-node)) (internal-marker-offsets (mapcar (lambda (node) (cons node (- (tui-marker-list-node-marker node) source-start))) internal-nodes)) ;; Copy source segment string (content-string (buffer-substring source-start source-end))) ;; Delete source segment (delete-region source-start source-end) ;; Delete target content (delete-region target-start target-end) (tui-marker-list-open-segment marker-list target-start-node target-end-node) (goto-char target-start) (insert content-string) ;; Update node references (when internal-nodes (let* ((last-internal-node (-last-item internal-nodes)) (first-internal-node (cl-first internal-nodes)) (source-previous-node (tui-marker-list-node-previous first-internal-node)) (source-next-node (tui-marker-list-node-next last-internal-node))) ;; front of target (setf (tui-marker-list-node-next target-start-node) first-internal-node) (setf (tui-marker-list-node-previous first-internal-node) target-start-node) ;; end of target (setf (tui-marker-list-node-next last-internal-node) target-end-node) (setf (tui-marker-list-node-previous target-end-node) last-internal-node) ;; source (setf (tui-marker-list-node-next source-previous-node) source-next-node) (setf (tui-marker-list-node-previous source-next-node) source-previous-node))) ;; Move all internal markers to their offset within the target segment (mapcar (-lambda ((node . offset)) (let ((marker (tui-marker-list-node-marker node))) (move-marker marker (+ target-start offset) (marker-buffer marker)))) internal-marker-offsets))))) (defun tui-marker-list-markers-in-range (marker-list start end) "Return marker nodes in MARKER-LIST within START and END (inclusive)." ;; TODO: allow imprecise positions (mapcar #'tui-marker-list-node-marker (tui-marker-list-nodes-in-range marker-list start end))) (defun tui-marker-list-markers-between (marker-list start end) "Return marker nodes in MARKER-LIST between START and END (exclusive)." ;; TODO: allow imprecise positions (mapcar #'tui-marker-list-node-marker (tui-marker-list-nodes-between marker-list start end))) ;;; Private methods (defun tui-marker-list-nodes-in-range (marker-list start end) "Return marker nodes in MARKER-LIST within START and END (inclusive)." ;; CLEANUP: optionally return the markers themselves? (let* ((start-node (tui-marker-list--get-single-node-at marker-list start)) (end-node (tui-marker-list--get-single-node-at marker-list end)) (stop-node (tui-marker-list-node-next end-node)) (this-node start-node) (nodes nil)) (progn (while (not (eq this-node stop-node)) (let ((next-node (tui-marker-list-node-next this-node))) (when (and (null next-node) stop-node) (error "Reached end of list before finding end marker")) (push this-node nodes) (setq this-node next-node))) (reverse nodes)))) (defun tui-marker-list-nodes-between (marker-list start end) "Return marker nodes in MARKER-LIST between START and END (exclusive)." (let* ((nodes (tui-marker-list-nodes-in-range marker-list start end))) (when (> (length nodes) 2) (-slice nodes 1 -1)))) (defun tui-marker-list--get-single-node-at (marker-list position) "Return a single marker node from MARKER-LIST at POSITION or signal an error if there are multiple coincident markers." (or ;; it's already a tui-marker-list-node (and (tui-marker-list-node-p position) position) ;; look up marker directly (gethash position (tui-marker-list-marker-table marker-list)) ;; find an equivalent marker (let ((nodes (tui-marker-list--nodes-at marker-list position))) (if (eq (length nodes) 1) (car nodes) (error "There are coincident markers at the given position. Use a marker from the marker list"))))) (defun tui-marker-list--nodes-at (marker-list position) "Return a list of marker nodes in MARKER-LIST at POSITION in order." (let* ((node (tui-marker-list-first marker-list)) node-position coincident-nodes) (while (and node (setq node-position (tui-marker-list-node-marker node)) (<= node-position position)) (when (= node-position position) (push node coincident-nodes)) (setq node (tui-marker-list-node-next node))) coincident-nodes)) ;;;; Node methods (defun tui-marker-list--marker-node (marker-list marker) "Return the linked list entry in MARKER-LIST for MARKER." (gethash marker (tui-marker-list-marker-table marker-list))) (defun tui-marker-list-preceding-coincident-nodes (marker-list node) "Return a list of marker nodes in MARKER-LIST logically preceding NODE with the same buffer position as NODE. Marker nodes returned preserve their list ordering." (let* ((marker (tui-marker-list-node-marker node)) (previous-node (tui-marker-list-node-previous node)) coincident-marker-nodes) (while (and previous-node (equal (tui-marker-list-node-marker previous-node) marker)) (push previous-node coincident-marker-nodes) (setq previous-node (tui-marker-list-node-previous previous-node))) coincident-marker-nodes)) (defun tui-marker-list-following-coincident-nodes (marker-list node) "Return a list of marker nodes in MARKER-LIST logically preceding NODE, but with the same buffer position as NODE. Marker nodes returned preserve their list ordering." (let* ((marker (tui-marker-list-node-marker node)) (next-node (tui-marker-list-node-next node)) coincident-marker-nodes) (while (and next-node (equal (tui-marker-list-node-marker next-node) marker)) (push next-node coincident-marker-nodes) (setq next-node (tui-marker-list-node-next next-node))) coincident-marker-nodes)) (provide 'tui-marker-list) (provide 'tui-marker-list) ;;; tui-marker-list.el ends here ================================================ FILE: tui-node-types.el ================================================ ;;; tui-node-types.el --- Core Tui Node Types -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'eieio) (require 'tui-plist) ;;;; Node (cl-defstruct tui-node "Base tui UI type." start ;; "Start of segment" end ;; "End of segment" content ;; "Current content of the node" mounted ;; "t if node is mounted in some buffer" relative-index ;; "Index position of node within parent (cached value)" marker-list ;; "Reference to the containing content tree's ordered marker list." id ;; "Unique identifier" (update-count 0)) (defun tui--new-id () "Generate a TUI ID." ;; TODO: use a non-repeating pseudo-random sequence? (abs (random))) ;;;; Text Node (cl-defstruct (tui-text-node (:include tui-node) (:constructor nil) (:constructor tui-text-node-create (&key content &aux (id (tui--new-id))))) "Primitive tui UI type for rendering text." nil) ;;;; Element (cl-defstruct (tui-element (:include tui-node) (:constructor nil) (:constructor tui-element-create (&key props invisible &aux (id (tui--new-id))))) props invisible ;; "Indicates whether the content element should be ignored when rendering." ) ;;;; Component (cl-defstruct (tui-component (:include tui-element)) ;; "The base class for all components." state) ;;;; Print methods (cl-defmethod cl-print-object ((node tui-node) stream) (princ (format "#" (tui-node-id node)) stream)) (cl-defmethod cl-object-print ((node tui-node) stream) (princ (format "#" (tui-node-id node)) stream)) (cl-defmethod cl-print-object ((element tui-element) stream) (princ (format "#" (tui-node-id element)) stream)) (cl-defmethod cl-object-print ((element tui-element) stream) (princ (format "#" (tui-node-id element)) stream)) (cl-defmethod cl-print-object ((component tui-component) stream) (princ (format "#" (tui--type component) (tui-node-id component)) stream)) (cl-defmethod cl-object-print ((component tui-component) stream) (princ (format "#" (tui--type component) (tui-node-id component)) stream)) ;;;; Type helpers (defun tui--type (node) "Return the NODE's type as a symbol." (when (tui-node-p node) (aref node 0))) (defun tui--object-class (obj) "Return symbol indicating the type of OBJ. Return a struct tag if OBJ is a `cl-defstruct' or the class symbol if an EIEIO class." ;; CLEANUP (cond ((tui-node-p obj) (aref obj 0)) ((and (featurep 'eieio) (eieio-object-p obj)) (eieio-object-class obj)))) (defun tui--object-of-class-p (obj class) "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." (if (and (featurep 'eieio) (eieio-object-p obj)) (child-of-class-p (tui--object-class obj) class) (funcall (intern (format "%s-p" (symbol-name class))) obj))) (defun tui--list-content-p (content) ;; CLEANUP: Eliminate this function? It shouldn't be necessary (element content is always a list and images should be detected first by the normalize function) "Return t if CONTENT is a list of content elements rather than potentially conflated content types (i.e. images)." (and (not (tui--image-p content)) (listp content))) (defun tui--image-p (content) "Return t if CONTENT is an image." (and (listp content) (eq (car content) 'image))) (cl-defmethod tui-equal ((node-a tui-node) node-b) "An `equal' function for `tui-node' objects. Return t if NODE-A and NODE-B have content that is respectively `tui-equal'." (and (tui-node-p node-b) (tui-equal (tui-node-content node-a) (tui-node-content node-b)))) (cl-defmethod tui-equal ((component-a tui-component) component-b) "An `equal' function for `tui-component' objects. Return t if COMPONENT-A and COMPONENT-B are the same type and have equal properties." (and (eq (tui--type component-a) (tui--type component-b)) (not (tui--plist-changes (tui--get-props component-a) (tui--get-props component-b))))) (cl-defmethod tui-equal (obj-a obj-b) "An `equal' function which handles `tui-*' objects recursively as a special case." (and (not (tui-node-p obj-b)) (cond ((eq obj-a obj-b) t) ((stringp obj-a) (equal obj-a obj-b)) ((-cons-pair-p obj-a) (equal obj-a obj-b)) ((and (listp obj-a) (listp obj-b) (not (-cons-pair-p obj-b))) (and (eq (length obj-a) (length obj-b)) (cl-loop for elt-a in obj-a for elt-b in obj-b always (tui-equal elt-a elt-b))))))) (cl-defun tui-component--docstring (documentation prop-documentation state-documentation) "Internal function for building component docstrings." (concat documentation (if prop-documentation (format "\n\nValid parameters include:\n%s" (s-join "\n" (cl-loop for (key docstring) on prop-documentation by #'cddr collect (format "\t%S\t\t%s\n" key docstring)))) "") (if state-documentation (format "\n\nInternal State variables:\n%s" (s-join "\n" (cl-loop for (key docstring) on state-documentation by #'cddr collect (format "\t%S\t\t%s\n" key docstring)))) ""))) (defun tui--cl-generic-remove-method (name qualifiers specializers) "cl-generic appears to lack an equivalent for common lisp's remove-method, so this should be sufficient for now to help clean up component definitions." (let* ((generic (cl-generic-ensure-function name)) (mt (cl--generic-method-table generic)) (me (cl--generic-member-method specializers qualifiers mt))) (unless (null me) (setf (cl--generic-method-table generic) (-filter (lambda (x) (not (eq x (car me)))) mt))))) (defun tui-unintern (type) "Remove all definitions for component TYPE. Return t if a component definition exists and was successfully removed and return nil otherwise." (interactive (tui-read-component-type "Unintern tui component: ")) (when (symbolp type) (setf (symbol-function type) nil) ;; TODO: Additional cl cleanup of struct definition (remhash type tui--default-props-table) (tui--cl-generic-remove-method 'tui-get-initial-state nil `(,type)) (tui--cl-generic-remove-method 'tui--mount nil '(,type)) (tui--cl-generic-remove-method 'tui-component-did-mount nil `(,type)) (tui--cl-generic-remove-method 'tui-get-derived-state-from-props nil `(,type)) (tui--cl-generic-remove-method 'tui-should-component-update nil `(,type)) (tui--cl-generic-remove-method 'tui-render nil `(,type)) (tui--cl-generic-remove-method 'tui-component-did-update nil `(,type)) (tui--cl-generic-remove-method 'tui-component-will-unmount nil `(,type)))) (cl-defmacro tui--component-defstruct (name) "Internal helper macro for defining component structs. Defines NAME as a struct resembling the structure of `tui-component'." `(progn (cl-defstruct (,name (:include tui-component) (:constructor nil) (:constructor ,(intern (format "%s-create" (symbol-name name))) (&key props invisible &aux (id (tui--new-id)))))) ;; FIXME: this is a rather hacky way of suppressing function creation for component slots (mapc (-lambda ((slot _ignore)) (unless (eq slot 'cl-tag-slot) (setf (symbol-function (intern (concat (symbol-name ',name) "-" (symbol-name slot)))) nil) (setf (symbol-function (intern (concat (symbol-name ',name) "-" (symbol-name slot) "--cmacro"))) nil))) (cl-struct-slot-info 'tui-component)) ',name)) (provide 'tui-node-types) ;;; tui-node-types.el ends here ================================================ FILE: tui-plist.el ================================================ (eval-when-compile (require 'cl-lib)) (require 'dash) (defun tui--plist-delete (plist &rest properties) "Delete PROPERTIES from PLIST. This is in contrast to merely setting it to 0. \(copied from `use-package-plist-delete')" (let ((property (car properties)) (rest-properties (cdr properties)) p) (while plist (if (not (eq property (car plist))) (setq p (plist-put p (car plist) (nth 1 plist)))) (setq plist (cddr plist))) (if rest-properties (apply #'tui--plist-delete p rest-properties) p))) (defun tui--plist-merge (a b &rest rest) "Merge plists A, B, and REST into a new list. Values for keys in successive list will override those preceding it. Ex: If a property key is found in plists A and B, the returned list will contain the value from B." (let* ((merged (cl-copy-seq a))) (cl-loop for (key val) on b by 'cddr do (setq merged (plist-put merged key val))) (if rest (apply #'tui--plist-merge merged rest) merged))) (defun tui--plist-equal (a b) "Helper to check wither plists A and B are equal." (declare (wip CLEANUP "be consistent about ignoring degeneracies. Currently only degeneracies in B are ignored.")) (let* ((b b)) (cl-loop for (key-a value-a) on a by #'cddr always (equal (plist-get b key-a) value-a) do (setq b (tui--plist-delete b key-a)) finally return (null b)))) (defun tui--symbol< (a b) "Compare the symbol names A and B." (string< (symbol-name a) (symbol-name b))) (defun tui--plist-to-sorted-alist (plist) "Convert PLIST to a sorted ALIST." (sort (cl-loop for (prop value) on plist by #'cddr collect (cons prop value)) (lambda (a b) (tui--symbol< (car a) (car b))))) (defun tui--plist-changes (old-plist new-plist) "Return a plist of differences between plists OLD-PLIST and NEW-PLIST." (let* ((old-list (tui--plist-to-sorted-alist old-plist)) (new-list (tui--plist-to-sorted-alist new-plist)) (-compare-fn (lambda (a b) (and ;; TODO: confirm #'eq is adequate and use that instead of the test immediately below ;; (eq (car a) (car b)) (equal (symbol-name (car a)) (symbol-name (car b))) (tui-equal (cdr a) (cdr b))))) (difference (-difference new-list old-list))) ;;(display-warning 'tui (format "(differences: %S)" (mapcar #'car difference)) :debug tui-log-buffer-name) (cl-loop for (key . value) in difference append (list key value)))) (defun tui--clean-plist (plist) "Remove degeneracies from plist." (let ((keys (make-hash-table :test #'equal)) (miss (make-symbol "miss")) new-plist) (cl-loop for (key value) on plist by #'cddr do (when (eq (gethash key table miss) miss) (puthash key key keys) (push value new-plist) (push key new-plist))) new-plist)) (defun tui--plist-keys (plist) "Return the keys of PLIST." (cl-loop for (key value) on plist by #'cddr collect key)) (provide 'tui-plist) ================================================ FILE: tui-reconciler.el ================================================ ;;; tui-reconciler.el --- Logic for diffing content trees -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-node-types) ;;; Code: (defun tui--diff (old-node new-node) "Compute a \"diff\" between OLD-NODE and NEW-NODE and return a list of patches that should be applied to the content tree." (cl-assert (or (null old-node) (tui--object-of-class-p old-node 'tui-node)) t "Diff must be applied to `tui-node's.") (cl-assert (or (null new-node) (tui--object-of-class-p old-node 'tui-node)) t "Diff must be applied to `tui-node's.") (cond ((and new-node (not old-node)) (list (list 'insert old-node))) ((and old-node (not new-node)) (list (list 'remove old-node))) ;; CLEANUP: should this be the only condition/test? ;; TODO: check that keys aren't different? ((eq (tui--object-class old-node) (tui--object-class new-node)) (cond ((tui-element-p old-node) (let ((old-props (tui--get-props old-node)) (new-props (tui--get-props new-node))) ;; update component if any properties have changed (when (tui--plist-changes old-props new-props) (list (list 'update-props old-node new-props))))) ((tui-text-node-p old-node) (when (not (equal-including-properties (tui-node-content old-node) (tui-node-content new-node))) (list (list 'update-content old-node (tui-node-update-count old-node) (tui-node-content new-node))))))) (t (list (list 'replace old-node new-node))))) (defun tui--diff-list (old-list new-list parent-element &optional index-offset) "Internal function for generating a diff between the content trees. OLD-LIST is the existing content (child nodes) of ELEMENT and NEW-LIST is the potentially updated content. INDEX-OFFSET tracks index position for recursive calculation of the DIFF." (unless index-offset (setq index-offset 0)) (let ((old-keys (tui--keyed-elements old-list)) (new-keys (tui--keyed-elements new-list)) diff) (while (or old-list new-list) (-let* ((old-item (cl-first old-list)) (old-class (tui--object-class old-item)) (old-key (tui--get-key old-item)) ((old-key-new-index . old-key-new-item) (gethash old-key new-keys)) (new-item (cl-first new-list)) (new-class (tui--object-class new-item)) (new-key (tui--get-key new-item)) ((new-key-old-index . new-key-old-item) (gethash new-key old-keys))) (cond ;; same-reconcile ((and (eq old-class new-class) (eq old-key new-key)) ;; FIXME: ensure the same test predicate as the hash table is used here (setq diff (append diff (tui--diff old-item new-item))) (pop old-list) (pop new-list) (setq index-offset (+ 1 index-offset))) ;; remove ((and old-item (or (not new-item) (if old-key (or (not old-key-new-index) ;; old item has key that is *not* preserved (not (eq old-class (tui--object-class old-key-new-item)))) (not (eq old-class new-class))))) (setq diff (append diff (list (list 'remove old-item)))) (pop old-list)) ;; reorder (insert) ((and new-key ;; new item has a key that is not currently first new-key-old-item) (setq diff (append diff (list (list 'insert new-key-old-item parent-element index-offset)))) (setq old-list (cons new-key-old-item (-remove (lambda (elt) (eq (tui--get-key elt) new-key)) ;; FIXME old-list)))) ;; insert (new-item (setq diff (append diff (list (list 'insert new-item parent-element index-offset)))) (pop old-list) (pop new-list) (setq index-offset (+ 1 index-offset)))))) diff)) (defun tui--get-key (element) "Return the :key of ELEMENT if defined and nil otherwise." (when (tui-element-p element) (plist-get (tui--get-props element) :key))) (defun tui--keyed-elements (nodes) "Return a hash table of `tui-element's in NODES with :key property defined as key-element pairs." (let ((map (make-hash-table))) ;; TODO: support strings as keys (but not use equal?) (-map-indexed (lambda (index node) (-when-let* ((key (tui--get-key node))) (puthash key (cons index node) map))) nodes) map)) (defun tui--reconcile (old-node new-node) "Reconcile element trees of OLD-NODE and NEW-NODE. Returns the outcome of that reconciliation process." (let ((diff (tui--diff old-node new-node))) (setf tui--update-queue (append diff tui--update-queue)) (unless tui--applying-updates (tui--process-update-queue)))) (defun tui--reconcile-content (old-content new-content parent-element) "Reconcile OLD-CONTENT and NEW-CONTENT within PARENT-ELEMENT." (cl-assert (tui--list-content-p old-content) t "Content tree is a list") (cl-assert (tui--list-content-p new-content) t "Content tree is a list") (let ((diff (tui--diff-list old-content new-content parent-element))) (setf tui--update-queue (append diff tui--update-queue)) (unless tui--applying-updates (tui--process-update-queue)))) ;; (cl-defmethod tui--reorder-element ((element tui-element) from-index to-index) ;; "Reorder items of ELEMENT- moving FROM-INDEX to TO-INDEX." ;; (tui-insert-node (nth from-index (tui-child-nodes element)) element to-index)) (provide 'tui-reconciler) ;;; tui-reconciler.el ends here ================================================ FILE: tui-ref.el ================================================ ;;; tui-ref.el ;;; Commentary: ;; (cl-defstruct (tui-ref (:constructor tui-create-ref)) element) (provide 'tui-ref) ;;; tui-ref.el ends here ================================================ FILE: tui-shared-size.el ================================================ ;;; tui-shared-size.el --- Shared sizes -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'tui-core) (require 'subr-x) ;;; Code: (cl-defstruct (tui-shared-size (:constructor nil) (:constructor tui-shared-size-create (&key size override-p))) size (element-sizes (make-hash-table)) (override-p nil)) (cl-defmethod tui-size (size) "Treat non-`tui-shared-size' SIZE object as a size value." size) (cl-defmethod tui-size ((shared-size tui-shared-size)) "Return the current prescribed size of SHARED-SIZE object." (tui-shared-size-size shared-size)) (cl-defmethod tui-request-size ((shared-size tui-shared-size) size element) "Register request by ELEMENT that SHARED-SIZE equal SIZE." (puthash element size (tui-shared-size-element-sizes shared-size))) (cl-defmethod tui-recalculate-size ((shared-size tui-shared-size)) "Recalculate SHARED-SIZE based requested sizes by its elements." (let* ((element-sizes (hash-table-values (tui-shared-size-element-sizes shared-size))) ;; (pixel-unit (listp (cl-first element-sizes))) (new-size (if (tui-shared-size-override-p shared-size) (tui-shared-size-size shared-size) (apply #'max (cons 1 element-sizes))))) (when new-size (setf (tui-shared-size-size shared-size) new-size) (mapcar (lambda (element) (cond ((tui-fixed-width-p element) (tui-fixed-width--update element)))) (hash-table-keys (tui-shared-size-element-sizes shared-size)))))) (provide 'tui-shared-size) ;;; tui-shared-size.el ends here ================================================ FILE: tui-snippets.el ================================================ ;;; tui-snippets.el --- Useful snippets -*- lexical-binding: t; -*- ;;; Commentary: ;; ;;; Code: (defvar tui-snippets-root (file-name-directory (or load-file-name (buffer-file-name)))) (defun tui-snippets-initialize () "Load tui snippets for use with yasnippet." (let ((snip-dir (expand-file-name "snippets" tui-snippets-root))) (when (boundp 'yas-snippet-dirs) (add-to-list 'yas-snippet-dirs snip-dir t)) (yas-load-directory snip-dir))) (eval-after-load "yasnippet" '(tui-snippets-initialize)) (provide 'tui-snippets) ;;; tui-snippets.el ends here ================================================ FILE: tui-tabstops.el ================================================ ;;; tui-tabstops.el --- -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (require 'tui-traversal) (defvar tui-cycle-tabstops t "Whether tabstops should loop around (i.e. go back to the beginning once you've reached the end).") (defun tui-tabstop-p (node) "Return t if NODE is a tabstop (has a truthy :tui-tabstop property)." (and (tui-element-p node) (plist-get (tui--get-props node) :tui-tabstop))) (cl-defun tui-next-tabstop (&optional pos) "Return a marker indicating the first tabstop following POS. Returns nil if a tabstop could not be found. See also: `tui-previous-tabstop'." (-when-let* ((element (or (tui-next-element pos #'tui-tabstop-p) (and tui-cycle-tabstops (tui-first-subtree-node #'tui-tabstop-p (tui-root-node)))))) (tui-start element))) (cl-defun tui-previous-tabstop (&optional pos) "Return a marker indicating the first tabstop preceding POS. Returns nil if a tabstop could not be found. See also: `tui-next-tabstop'." (-when-let* ((element (or (tui-previous-element pos #'tui-tabstop-p) (and tui-cycle-tabstops (tui-last-subtree-node #'tui-tabstop-p (tui-root-node)))))) (tui-start element))) (cl-defun tui-forward-tabstop (&optional (num 1)) "Move forward NUM tabstops. Negative NUM values will move backward. See also: `tui-backward-tabstop'." (interactive "p") (dotimes (n num) (-when-let* ((tabstop (tui-next-tabstop (point)))) (goto-char tabstop)))) (cl-defun tui-backward-tabstop (&optional (num 1)) "Move forward NUM tabstops. Negative NUM values will move forward. See also: `tui-forward-tabstop'." (interactive "p") (dotimes (n num) (-when-let* ((tabstop (tui-previous-tabstop (point)))) (goto-char tabstop)))) (eval-after-load "avy" (defun tui-avy-jump-tabstop () "" (interactive) ;; TODO: see avy--process )) (provide 'tui-tabstops) ;;; tui-tabstops.el ends here ================================================ FILE: tui-text-props.el ================================================ ;;; tui-text-props.el --- Text properies -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (defvar tui--text-props (make-hash-table :weakness 'key) "Cache for inherited text properties (keys and values) of elements. Keys are elements and values are text properties encoded as alists.") (defvar tui--own-text-prop-keys (make-hash-table :weakness 'key) "Cache of text property keys set on each element.") (defvar tui--grouped-text-props (make-hash-table :weakness 'key) "Cache for text properties of elements (not inherited). Text properties are alists grouped by replacement mode (REPLACE PUSH APPEND SAFE).") (defun tui--get-merged-text-props (element) "Return the calculated text props of ELEMENT as an alist. This includes inherited text properties." (let* ((cached-props (gethash element tui--text-props 'miss))) (if (eq cached-props 'miss) (let* ((parent (tui-parent element))) (puthash element (tui--extend-text-props (when parent (tui--get-merged-text-props parent)) (tui--get-grouped-text-props element)) tui--text-props)) cached-props))) (defun tui--get-text-prop-keys (element) "" (let* ((keys (gethash element tui--own-text-prop-keys 'miss))) (if (eq keys 'miss) (puthash element (-uniq (mapcar #'car (apply #'append (tui--get-grouped-text-props element)))) tui--own-text-prop-keys) keys))) (defun tui-get-text-props (element) "Return the calculated text properties of ELEMENT as a plist." (let* ((keys (make-hash-table :test #'equal)) text-props) (cl-loop for (key value) on (tui--get-merged-text-props element) by #'cddr do (unless (gethash key keys) (push value text-props) (push key text-props) (puthash key key keys))) text-props)) (defun tui--get-grouped-text-props (element) "Return text props grouped by their application rule (replace push append safe) applied that should be applied to children of ELEMENT." (or (gethash element tui--grouped-text-props) (let* ((props (tui--get-props element)) (replace (or (plist-get props :text-props) (plist-get props :text-props-replace))) (push (plist-get props :text-props-push)) (append (plist-get props :text-props-append)) (safe (plist-get props :text-props-safe))) (puthash element (list replace push append safe) tui--grouped-text-props)))) (defun tui--extend-text-props (target-props grouped-props) "Internal function. Merge GROUPED-PROPS text property descriptions structured as `(replace push append safe)' into TARGET-PROPS with proper inheritance." (-let* (((replace push append safe) grouped-props) (target-props (nreverse (cl-loop for (key value) on target-props by #'cddr collect (cons key value)))) (prop-table (make-hash-table :test #'equal)) (miss (make-symbol "miss")) (merged-props nil)) (cl-loop for (key . value) in target-props do (puthash key value prop-table)) (cl-loop for (key value) on safe by #'cddr for existing-value = (gethash key prop-table miss) do (if (eq existing-value miss) (puthash key value prop-table))) (cl-loop for (key value) on push by #'cddr for existing-value = (gethash key prop-table miss) do (cond ((eq existing-value miss) (puthash key value prop-table)) ((listp existing-value) (puthash key (cons value existing-value) prop-table)) (t (puthash key (cons value (list existing-value)) prop-table)))) (cl-loop for (key value) on append by #'cddr for existing-value = (gethash key prop-table miss) do (cond ((eq existing-value miss) (puthash key value prop-table)) ((listp existing-value) (puthash key (append existing-value (list value)) prop-table)) (t (puthash key (cons existing-value (list value)) prop-table)))) (cl-loop for (key value) on replace by #'cddr do (puthash key value prop-table)) (maphash (lambda (key value) (setf merged-props (append (list key value) merged-props))) prop-table) merged-props)) ;; (defun tui--get-calculated-grouped-text-props (node) ;; "Return a list of text properties inherited from NODE and NODE's parent elements." ;; (if (not node) ;; '(nil nil nil nil) ;; (or (tui--clean-plist (gethash node tui--text-props)) ;; (puthash node ;; (tui--apply-grouped-text-props ;; (tui--get-calculated-grouped-text-props (tui-parent node)) ;; (tui--get-grouped-text-props node)) ;; tui--text-props)))) ;; (defun tui--clear-cached-text-props (node) ;; ;; TODO: inadvisable; doesn't leverage inheritance structure ;; "Clear cache text props for NODE.";; and all of its descendents." ;; (remhash node tui--text-props) ;; (remhash node tui--grouped-text-props) ;; ;; (let ((nodes (list node))) ;; ;; (while nodes ;; ;; (let ((node (pop nodes))) ;; ;; (remhash node tui--text-props) ;; ;; (remhash node tui--grouped-text-props) ;; ;; (setf nodes (append (tui-child-nodes node) ;; ;; nodes))))) ;; ) ;; (cl-defmethod tui--apply-text-props ((node tui-node)) ;; "" ;; nil) ;; (cl-defmethod tui--apply-text-props ((element tui-element)) ;; "" ;; (-let* (((start . end) (tui-segment element)) ;; ((replace push append safe) (tui--get-grouped-text-props element)) ;; (buffer (marker-buffer start))) ;; (when replace ;; (tui-put-text-properties start end replace buffer t)) ;; (when push ;; (tui-put-text-properties start end push buffer 'push)) ;; (when append ;; (tui-put-text-properties start end append buffer 'append)) ;; (when safe ;; (tui-put-text-properties start end safe buffer nil)))) (defun tui--text-prop-changes (old-props new-props) "Return :text-props* values that are different between old-props and new-props." (cl-loop for (key _value) on (tui--plist-changes old-props new-props) by #'cddr if (member key '(:text-props :text-props-push :text-props-append :text-props-replace :text-props-safe)) collect key)) (defun tui-put-text-property (start end key value &optional object replace-behavior) "Same as `tui-put-text-properties', but only set a single key-value pair." (tui-put-text-properties start end (list key value) object replace-behavior)) (defun tui-put-text-properties (start end properties &optional object replace-behavior) "Apply text properties to region between START and END. Like `put-text-property, but PROPERTIES is a list of properties and has controllable REPLACE-BEHAVIOR. Unlike `put-text-property` the default behavior is to not replace existing property values. When REPLACE-BEHAVIOR is t existing values for properties are replaced with the new value from PROPERTIES. When REPLACE-BEHAVIOR is nil, existing values are not replaced; the value from PROPERTIES is not applied. When REPLACE-BEHAVIOR is 'push, a new value is added to the front of a list of existing values. When REPLACE-BEHAVIOR is 'append, a new value is added in the manner of 'push, but at the end of the list. If the optional OBJECT is a buffer, START and END are buffer positions. If OBJECT is a string, START and END are 0-based indices into it. When OBJECT is nil, properties are applied to the current buffer." (when (and (not object) (markerp start)) (setq object (marker-buffer start))) (let (prop-end prop-start) ;; (message "-safe-propertize\n") (cl-loop for (key value) on properties by #'cddr do (setq prop-start nil prop-end nil) (if (eq replace-behavior t) (progn ;;(message "putting property %S at %S-%S" key start end) (put-text-property start end key value object)) (while (and (< (setq prop-start (if prop-start (next-single-property-change prop-end key object end) start)) end) (setq prop-end (next-single-property-change prop-start key object end))) (let ((existing-value (get-text-property prop-start key object))) (when (or replace-behavior (not existing-value)) ;;(message "putting property %S at %S-%S" key prop-start prop-end) (put-text-property prop-start prop-end key (pcase replace-behavior ('push (append (list value) (if (listp existing-value) existing-value (list existing-value)))) ('append (append (if (listp existing-value) existing-value (list existing-value)) (list value))) (_ value)) object)))))))) (defun tui--apply-inherited-text-props (start end element &optional object) ;; CLEANUP: bad function signature "Internal function to apply inherited text properties. Applies text properties to region between START and END inherited from ELEMENT. Optional argument OBJECT is a string to which the properties be applied. START and END should indicate positions within that string." (unless start (setq start (tui-start element))) (unless end (setq end (tui-end element))) (-let* ((text-props (tui-get-text-props element))) (tui-put-text-properties start end text-props (marker-buffer start) t))) (defun tui--update-text-props (subtree changed-props) "Update text properties in SUBTREE." (cl-loop for (key value) on changed-props by #'cddr do ;; set the text properties for the entire region (let* ((start (tui-start subtree)) (end (tui-end subtree))) (put-text-property start end key value (marker-buffer start))) ;; find first descendents that touch changed text-props (tui-map-subtree (lambda (node) (when (member key (gethash node tui--text-props)) ;; update this node ;;(tui--apply-inherited-text-props )) subtree))) (provide 'tui-text-props) ;;; tui-text-props.el ends here ================================================ FILE: tui-traversal.el ================================================ (eval-when-compile (require 'cl-lib)) (require 'dash) (defun tui-map-subtree (fn node) "Apply FN to all elements in the subtree of NODE." (let* ((nodes (list node))) (while nodes (let* ((node (pop nodes))) (cond ((tui-element-p node) (funcall fn node) (push (tui-child-nodes node) nodes)) ;; CLEANUP: better handling of list nodes ((listp node) (setq nodes (append node nodes)))))))) (cl-defun tui-first-subtree-node (predicate node) "Return the first node in the subtree of NODE that satisfies PREDICATE. See also: `tui-last-subtree-node'." (let* ((nodes (list node)) current-node) (while (and (setq current-node (pop nodes)) (not (funcall predicate current-node))) (when (tui-element-p current-node) (setq nodes (append (tui-child-nodes current-node) nodes)))) current-node)) (cl-defun tui-last-subtree-node (predicate node) "Return the last node in the subtree of NODE that satisfies PREDICATE. See also: `tui-first-subtree-node'." (or (-some (lambda (child) (tui-last-subtree-node predicate child)) (reverse (tui-child-nodes node))) (when (funcall predicate node) node))) (provide 'tui-traversal) ================================================ FILE: tui-type-helpers.el ================================================ (provide 'tui-type-helpers) ================================================ FILE: tui-util-ui.el ================================================ (eval-when-compile (require 'cl-lib)) (require 'edebug) (require 'tui-defun) (require 'tui-util) (defun tui-element-label (element) "" (prin1-to-string (tui--type element))) (defun tui--prin1-to-string (value) "" (let* ((print-level nil) (print-length nil)) (with-temp-buffer (insert (edebug-safe-prin1-to-string value)) (goto-char (point-min)) (ignore-errors (lispy-alt-multiline t)) (buffer-substring (point-min) (point-max))))) (tui-defun tui--plist-summary (plist) "" (let* ((edebug-print-length 200) (edebug-print-level 50)) (cl-loop for (key value) on plist by 'cddr collect (tui-line (prin1-to-string (keyword->symbol key)) ": " (tui--prin1-to-string value))))) (tui-defun tui-element-summary (element) "Information summary about ELEMENT." (declare (wip TODO "abbreviate state and prop values" TODO "put props and state in expanders")) (let* ((props (tui-element-props element)) (state (tui-component-state element))) (list (tui-heading (tui-element-label element)) (tui-line "Mount point: " (edebug-safe-prin1-to-string (tui-element-start element))) (tui-line "Source definition: ") (tui-line (format "Properties (%d): " (length (tui--plist-keys props)))) (tui-prefix-lines :prefix " " (tui--plist-summary :plist props)) (tui-line (format "State (%d): " (length (tui--plist-keys state)))) (tui-prefix-lines :prefix " " (tui--plist-summary :plist state))))) (cl-defmacro tui-with-feature (feature &rest body) "Evaluate BODY if FEATURE is available. Otherwise display an error indicating FEATURE is not available." (declare (indent 1)) `(or (condition-case with-feature-err (not (require ,feature)) (t (format "Error requiring feature '%s': %s" ,feature with-feature-err))) (list ,@body))) (provide 'tui-util-ui) ================================================ FILE: tui-util.el ================================================ ;;; tui-util.el --- Utility functions for tui -*- lexical-binding: t; -*- ;;; Commentary: ;; (eval-when-compile (require 'cl-lib)) (require 'dash) (require 's) (require 'tui-core) (require 'tui-dom) (require 'tui-node-types) ;;; Code: (defun tui-valid-element-p (element &optional invisible-context) "Return t if ELEMENT is a valid `tui-element'. Optional argument INVISIBLE-CONTEXT track whether the this node is within an invisible section of the content tree." (and (not (cl-assert (tui-element-p element) t "Element should be a tui-element.")) (or (not (tui-node-mounted element)) (tui--object-of-class-p element 'tui-buffer) ;; CLEANUP: is this exclusion necessary? (-let* (((start . end) (tui-segment element)) (children (tui-child-nodes element)) (-compare-fn #'eq)) (and (not (cl-assert (or (not start) (and (markerp start) (marker-buffer end) (marker-position end))) t "When set, start marker should be a marker object that points somewhere.")) (not (cl-assert (or (not end) (and (markerp end) (marker-buffer start) (marker-position start))) t "When set, end marker should be a marker object that points somewhere.")) (not (cl-assert (listp children) t "Children should be represented by a list")) ;; all children are adjacent with consolidated markers (or invisible-context (tui-invisible-p element) (-all-p (lambda (child) (not (cl-assert (and (>= (tui-start child) start) (<= (tui-start child) end) (>= (tui-end child) start) (<= (tui-end child) end)) t "Internal child markers should exist within the parent's segment"))) children))))) ;; All child nodes are valid as well (-all-p (lambda (child) (or (and (not (tui-element-p child)) (tui-node-p child)) (tui-valid-element-p child (or invisible-context (tui-invisible-p element))))) (tui-child-nodes element)))) (defun tui-valid-content-tree-p (node) "Return t if NODE belongs to a valid content tree." (tui-valid-element-p (tui-root-node node))) (defun tui--target-row-offset (num-columns current-column-index steps-forward) "Helper function to calculate the row offset for movement within a grid. Calculate the row offset of moving STEPS-FORWARD on a grid consisting of NUM-COLUMNS assuming a current position of CURRENT-COLUMN-INDEX." (let ((target-index (+ steps-forward current-column-index))) (if (>= target-index 0) (/ target-index num-columns) (- -1 (/ (abs target-index) num-columns))))) (defun tui--target-column-index (num-columns current-column-index steps-forward) "Helper function to calculate the target column index for movement within a grid. Calculate the target column index for moving STEPS-FORWARD on a grid consisting of NUM-COLUMNS assuming a current position of CURRENT-COLUMN-INDEX." (let ((target-index (+ steps-forward current-column-index))) (if (>= target-index 0) (% target-index num-columns) (+ num-columns (% target-index num-columns))))) (defmacro tui-let (bindings &rest body) "Convenience form for binding state and prop values of BINDINGS for evaluation of BODY. For use in any context where `tui-get-props' and `tui-get-state' are defined. See: `tui-let*'." (declare (debug ((&rest symbolp) body)) (indent 1)) `(tui-let* (,bindings tui-this-component) ,@body)) (defmacro tui-let* (bindings &rest body) "Convenience form for binding state and prop values from a component reference for the execution of BODY. BINDINGS should be a list of the form (&props PROP-A PROP-B ... &state STATE-VAR-A ...)." (declare (debug ((&rest symbolp) body)) (indent 1)) (-let* (((symbol-args this-ref) bindings) (this-sym (make-symbol "this")) (prop-sym (make-symbol "prop")) (state-sym (make-symbol "state")) prop-vars state-vars) (while (member (car symbol-args) '(&props &state)) (let* ((var-count (or (-find-index (lambda (item) (member item '(&props &state))) (cl-rest symbol-args)) (length (cl-rest symbol-args))))) (pcase (pop symbol-args) ('&props (setq prop-vars (append prop-vars (-take var-count symbol-args)))) ('&state (setq state-vars (append state-vars (-take var-count symbol-args))))) (setq symbol-args (nthcdr var-count symbol-args)))) `(let* ,(append `((,this-sym ,this-ref)) (when prop-vars `((,prop-sym (tui-get-props ,this-sym)))) (when state-vars `((,state-sym (tui-get-state ,this-sym)))) (mapcar (lambda (var) `(,var (plist-get ,prop-sym ,(intern (concat ":" (symbol-name var)))))) prop-vars) (mapcar (lambda (var) `(,var (plist-get ,state-sym ,(intern (concat ":" (symbol-name var)))))) state-vars)) ,@body))) (defun tui-viewport-height () "Return the height of the containing viewport (in rows)." (window-text-height)) (defun tui-viewport-width () "Return the width of the containing viewport (in columns)." (window-text-width)) (cl-defmethod tui-run-with-timer ((component tui-component) secs repeat cancel-on-error function &rest args) "`run-with-timer' for as long as COMPONENT is mounted. The timer lifecycle is tied to the lifecycle of the component, so the timer is canceled when the associated component is unmounted. When optional argument CANCEL-ON-ERROR is truthy cancel the timer if FUNCTION throws an error." (let* ((timer (list nil))) (setq timer (apply #'run-with-timer secs repeat (lambda (&rest args) (if (not (tui-mounted-p component)) (cancel-timer timer) (if cancel-on-error (apply function args) (condition-case-unless-debug err (apply function args) (error (message "%s" (error-message-string err)) (cancel-timer timer)))))) args)))) (defun tui-component-symbol-p (sym) "Return t if SYM refers to a tui-component." (and (symbolp sym) (symbol-function sym) (when (cl--find-class sym) (member 'tui-component (mapcar #'cl--struct-class-name (cl--struct-all-parents (cl--struct-get-class sym))))))) (defun tui-all-component-types () "Return a list of symbols for all tui components that have been defined." (let* (types) (cl-do-symbols (symbol) (when (tui-component-symbol-p symbol) (push symbol types))) types)) (defun tui-builtin-component-type-p (type) "" (when (symbolp type) (setq type (symbol-name type))) (s-matches-p "^tui" type)) (defun tui-all-builtin-component-types () "Return a list of all ``built-in'' component types (``tui-'')." (-filter #'tui-builtin-component-type-p (tui-all-component-types))) ;; (tui-read-component-type String -> Symbol) (cl-defun tui-read-component-type (&optional (prompt "Component type: ")) "Return a component type. Optionally override PROMPT string." (intern (completing-read prompt (tui-all-component-types)))) (defun tui-node-label (node) "Return a terse (human) label string for NODE." (format "%s (%s)" (tui--type node) (tui-node-id node))) ;; TODO: eliminate? (defalias 'tui-element-label 'tui-node-label) (cl-defun tui-read-element-at-point (&optional (prompt "Element: ")) "Return a user-selected element at point. Optionally override PROMPT string." (let* ((elements (tui-ancestor-elements-at (point))) (options (--map (cons (tui-element-label it) it) elements))) (assoc-default (completing-read prompt options) options))) (defun tui--abbreviate-string (length string) "Abbreviate STRING to LENGTH with ellipsis ``…''." (declare (wip TODO "maintain the overall length?")) (if (<= (length string) length) string (propertize (s-truncate length string "…") 'help-echo string))) (defun tui-util--shr-render-html-to-string (html-string) "Render HTML-STRING to a string." (let* ((html-dom (with-temp-buffer (insert html-string) (libxml-parse-html-region (point-min) (point-max))))) (with-temp-buffer (shr-insert-document html-dom) (buffer-string)))) (defun tui--easy-going-apply (fn &rest arguments) "Make an ``easy-going'' funcall to FN with args- tolerating FN definitions with arity of four fewer than the length of arguments. The last value of ARGUMENTS is treated as a list of args (the same way as `apply')." (-let* ((args (apply #'apply #'list arguments)) (max-arity (cdr (func-arity fn)))) (apply fn (if (eq max-arity 'many) args (seq-take args max-arity))))) ;; (tui--easy-going-apply (lambda (x y z) (list x y z)) 1 2 '(3 4 5)) (provide 'tui-util) ;;; tui-util.el ends here ================================================ FILE: tui.el ================================================ ;;; tui.el --- Text-based UI framework modeled after React -*- lexical-binding: t; -*- ;; Copyright (C) 2017, 2020 Erik Anderson ;; Author: Erik Anderson ;; Homepage: https://github.com/ebpa/tui.el ;; Keywords: maint ;; Version: 0.0.4 ;; Package-Requires: ((emacs "26.1") (cl-lib "0.6.1") (s "1.12.0") (dash "2.18.0")) ;; 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 . ;;; Commentary: ;; An experimental text-based UI framework modeled after React. ;;; Code: (eval-when-compile (require 'cl-lib)) ;; Components (require 'tui-components) ;; Layout (require 'tui-absolute-container "layout/tui-absolute-container.el") (require 'tui-demo "demo/tui-demo.el") (require 'tui-dev) (require 'tui-errors) (require 'tui-defun) (require 'tui-inspect) (require 'tui-reconciler) (require 'tui-shared-size) (require 'tui-snippets) (require 'tui-tabstops) (require 'tui-type-helpers) (require 'tui-util) (require 'tui-util-ui) (provide 'tui) ;;; tui.el ends here