branch: externals/poke
commit e4ad616ace072aaf9577202575375a1589460950
Author: Jose E. Marchesi <[email protected]>
Commit: Jose E. Marchesi <[email protected]>
Initial commit
---
COPYING | 674 ++++++++++++++++++++++++
README | 4 +
poke-el.texi | 227 ++++++++
poke.el | 1630 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 2535 insertions(+)
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000000..94a9ed024d
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/README b/README
new file mode 100644
index 0000000000..796c2377df
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+poke.el is an Emacs interface for GNU poke, the extensible editor for
+structured binary data [1].
+
+[1] https://jemarch.net/poke
diff --git a/poke-el.texi b/poke-el.texi
new file mode 100644
index 0000000000..f6b44bbef5
--- /dev/null
+++ b/poke-el.texi
@@ -0,0 +1,227 @@
+\input texinfo
+@comment %**start of header
+@documentencoding UTF-8
+@setfilename poke-el.info
+@settitle Emacs interface to GNU poke
+@set UPDATED 21 March 2022
+@set VERSION 2.1
+@afourpaper
+@comment %**end of header
+
+@macro ie
+@i{i.e.}
+@end macro
+
+@copying
+Copyright @copyright{} 2022 Jose E. Marchesi.
+
+@quotation
+You can redistribute it and/or modify this manual 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.
+@end quotation
+@end copying
+
+@dircategory Emacs
+@direntry
+* Emacs meets GNU poke: (poke-el). Emacs interface to GNU poke
+@end direntry
+
+@titlepage
+@title poke-el: an Emacs interface to GNU poke
+@subtitle for version @value{VERSION}, @value{UPDATED}
+@author by Jose E. Marchesi
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top poke-el: an Emacs interface to GNU poke
+
+This manual documents version @value{VERSION} of poke.el.
+
+@insertcopying
+@end ifnottex
+
+@menu
+* Introduction:: Getting started
+
+@detailmenu
+ --- The Detailed Node Listing ---
+
+Introduction
+
+* Installation:: How to install this package
+* Configuration:: Loading and configuring
+* Running:: Running and exiting poke
+* Feedback:: Bug reports, ideas, patches @i{etc}.
+@end detailmenu
+@end menu
+
+@node Introduction
+@chapter Introduction
+
+poke-el is an Emacs interface to GNU
+poke@footnote{@url{https://jemarch.net/poke}}, the extensible editor
+for structured binary data.
+
+@menu
+* Installation:: How to install this package
+* Configuration:: Loading and configuring
+* Running:: Running and exiting poke
+* Feedback:: Bug reports, ideas, patches @i{etc}.
+@end menu
+
+@node Installation
+@section Installation
+
+This program is implemented in a self-contained elisp file called
+@file{poke.el}. It can be obtained in several ways:
+
+@itemize @minus
+@item From @url{https://elpa.gnu.org/packages/poke.html, GNU ELPA}
+using the built-in Emacs package manager.
+@item As part of the source tree cloned from the development git
+repository of GNU poke. @file{poke.el} can be found in the
+@file{emacs/} directory of the GNU poke source tree.
+@item As a single file downloaded form some other location in
+internet.
+@item It may be already installed as part of a binary package in some
+distribution.
+@end itemize
+
+@noindent In the second case you need to tell Emacs where to locate the
+@file{poke.el} file and to load it. Add the following to your
+@file{.emacs} file.
+
+@lisp
+(add-to-list 'load-path "~/path/to/poke-el/")
+(require 'poke)
+@end lisp
+
+@noindent If @file{poke.el} was installed as part of a binary
+package in a distribution then you usually don't have to touch the
+@code{load-path} variable. Depending on the specific case you may
+have to @code{require} the package.
+
+@node Configuration
+@section Configuration
+@cindex configuration
+
+Once loaded, there are many aspects of poke-el that can be configured
+by the user.
+
+@menu
+* Settings:: Output numeration base and other settings.
+* Window Layouts:: Predefined layouts.
+@end menu
+
+@node Settings
+@subsection Settings
+
+The following variables can be customized in order to change the
+default behavior of poke.
+
+@table @code
+@item poke-setting-pretty-print
+Indicates whether Poke values are pretty-printed. Valid values are
+the strings @code{"yes"} and @code{"no}. Defaults to @code{"no"}.
+@item poke-setting-omode
+The numeration base to use when printing numerical values. Valid
+values are 2, 8, 10 and 16. Defaults to 10.
+@item poke-setting-omode
+How to print composite Poke values, such as arrays and structs. Valid
+values are @code{"plain"} and @code{"tree"}.
+@end table
+
+Note that all the settings above can be interactively changed at any
+time using the settings editor. XXX xref.
+
+@node Window Layouts
+@subsection Window Layouts
+
+The poke Emacs interface is composed by many different buffers, each
+playing a different role: the repl, the bytes viewer, the settings
+editor, the maps tree, @i{etc}. When using the interface, actions
+will often result in many of these buffers to be displayed using
+@code{switch-to-buffer-other-window}.
+
+In Emacs it is possible to configure how buffers are associated to
+windows by customizing the @code{display-buffer-alist} variable. This
+is often used in order to make the interface more predictable, @ie{} to
+always have certain of the buffers shown in the same area of the
+screen.
+
+poke-el provides an example of such a configuration, that you can use
+as-is or as the basis of your own layouts, in the function
+@code{poke-frame-layout-1}. This function appends entries to
+@code{display-buffer-alist}. It implements the following window
+layout:
+
+@smallexample
+@group
+ ___________________________________
+ | |
+ | *poke-vu* |
+ | |
+ |___________________________________|
+ | | |
+ | | |
+ | | *poke-maps*/ |
+ | | *poke-edit*/ |
+ | *poke-repl* | *poke-code*/ |
+ | | *poke-ios*/ |
+ | | *poke-settings*|
+ | | |
+ |__________________|________________|
+ | |
+ | *poke-out* |
+ |___________________________________|
+@end group
+@end smallexample
+
+To use this layout, simply include this call in your
+@file{.emacs}:
+
+@lisp
+(poke-frame-layout-1)
+@end lisp
+
+@node Running
+@section Running
+
+Once you have loaded and configured poke-el, it is time to run poke!
+To do so, simply issue @kbd{M-xpoke}.
+
+This command will start the poke daemon if it wasn't already running
+and initialize the interface if necessary. Then it will show the poke
+windows in the current frame (using whatever configured layout.
+@xref{Window Layouts}) and drop you on the poke REPL.
+
+In order to exit poke, you can either use the command
+@kbd{M-xpoke-exit} or the @command{quit} command at the repl:
+
+@example
+#!poke!# quit
+@end example
+
+@node Feedback
+@section Feedback
+@cindex feedback
+@cindex bug reports
+
+If you find problems with poke-el, or if you have questions, remarks,
+or ideas about it, please mail to the GNU poke mailing list
+@email{poke-devel@@gnu.org}. If you are not a member of the mailing
+list, your mail will be passed to the list after a moderator has
+approved it@footnote{Please consider subscribing to the mailing list,
+in order to minimize the work the mailing list moderators have to do.
+The subscription can be done online at
+@url{http://lists.gnu.org/mailman/listinfo/poke-devel}.}.
+
+@bye
diff --git a/poke.el b/poke.el
new file mode 100644
index 0000000000..c639b6ab4d
--- /dev/null
+++ b/poke.el
@@ -0,0 +1,1630 @@
+;;; poke.el --- Emacs meets GNU poke!
+
+;; Copyright (C) 2022 Jose E. Marchesi
+;; Author: Jose E. Marchesi <[email protected]>
+;; Maintainer: Jose E. Marchesi <[email protected]>
+;; URL: https://www.jemarch.net/poke
+;; Package-Requires: ((emacs "25"))
+;; Version: 2.1
+
+;; This file is NOT part of GNU Emacs.
+
+;; 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file implements a Emacs interface to GNU poke, the extensible
+;; editor for structured binary data.
+;;
+;; It uses the poked (GNU poke daemon) in order to act as a set of
+;; pokelets:
+;;
+;; poke-out
+;; connected to the poked output channel 1.
+;; poke-cmd
+;; connected to the poked input channel 2.
+;; poke-code
+;; connected to the poked input channel 3.
+;; poke-vu
+;; connected to the poked output channel 2.
+;; poke-complete
+;; connected to the poked output channel 5.
+;; poke-elval
+;; connected to the poked output channel 100.
+
+;;; Code:
+
+(require 'comint)
+(require 'subr-x)
+(require 'tabulated-list)
+(require 'poke-mode)
+(require 'widget)
+(require 'cl)
+
+;;;; First, some utilities
+
+(defun poke-decode-u64-le (seq)
+ (logior (ash (aref seq 7) 56)
+ (ash (aref seq 6) 48)
+ (ash (aref seq 5) 40)
+ (ash (aref seq 4) 32)
+ (ash (aref seq 3) 24)
+ (ash (aref seq 2) 16)
+ (ash (aref seq 1) 8)
+ (aref seq 0)))
+
+;;;; Faces
+
+(defface poke-integer-face '((t :foreground "green"))
+ "Face for printing Poke integer values.")
+(defface poke-string-face '((t :inherit font-lock-string-face))
+ "Face for printing Poke string values.")
+(defface poke-offset-face '((t :foreground "yellow"))
+ "Face for printing Poke offsets.")
+(defface poke-struct-field-name-face '((t :underline t))
+ "Face for printing Poke struct field names.")
+(defface poke-vu-addr-face '((t :bold t))
+ "Face for printing line addresses in VU mode.")
+(defface poke-vu-ascii-face '((t :foreground "red"))
+ "Face for printing ascii in VU mode.")
+(defface poke-diff-field-name-face '((t :underline t))
+ "Face for printing thunk field names.")
+(defface poke-diff-thunk-header-face '((t :bold t))
+ "Face for thunk headers.")
+(defface poke-diff-minus-face '((t :foreground "red"))
+ "Face for deletion thunk lines.")
+(defface poke-diff-plus-face '((t :foreground "green"))
+ "Face for addition thunk lines.")
+(defface poke-iter-string-face '((t :bold t))
+ "Face for iteration separator in *poke-out* buffer.")
+(defface poke-error-face '((t :bold t :foreground "red"))
+ "Face for error messages.")
+(defface poke-warning-face '((t :foreground "yellow"))
+ "Face for warning messages.")
+(defface poke-vu-selected-byte-face '((t :background "yellow"))
+ "Face for selected byte in poke-vu buffers.")
+(defface poke-vu-highlighted-byte-face '((t :background "green"))
+ "Face for highlighted byte in poke-vu buffers.")
+(defface poke-edit-header-face '((t :bold t))
+ "Face for editor headers.")
+
+;;;; Poke styling classes
+
+(defvar poke-styling-faces
+ '(("integer" poke-integer-face)
+ ("string" poke-string-face)
+ ("offset" poke-offset-face)
+ ("struct-field-name" poke-struct-field-name-face)
+ ("diff-thunk-header" poke-diff-thunk-header-face)
+ ("diff-minus" poke-diff-minus-face)
+ ("diff-plus" poke-diff-plus-face)
+ ("error" poke-error-face)
+ ("warning" poke-warning-face))
+ "GNU poke uses named styling classes in order to style the
+ output we get through the pokelets. This variable associates
+ Poke styling class names with Emacs faces.")
+
+;;;; poked
+
+(defvar poke-poked-program "poked"
+ "poke.el uses the poke daemon (poked) in order to communicate
+ with GNU poke. This variable contains the name of the program
+ to execute the daemon.")
+
+(defvar poke-poked-process nil
+ "Process running the poke daemon.")
+
+(defvar poked-socket "/tmp/poked.ipc"
+ "Unix domain socket where the poke daemon listens for
+ connections.")
+
+(defun poke-poked ()
+ "Start the poke daemon. The new process is associated with the
+buffer `*poked*'."
+ (interactive)
+ (when (not (process-live-p poke-poked-process))
+ (setq poke-poked-process
+ (make-process :name "poked"
+ :buffer "*poked*"
+ :command (list poke-poked-program "--debug")))
+ (set-process-query-on-exit-flag poke-poked-process nil)))
+
+;;;; pokelet protocol
+
+(defconst PLET_STATE_LENGTH 0) ; Collecting length bytes.
+(defconst PLET_STATE_MSG 1) ; Collecting message data.
+
+(defun poke-pokelet-filter (proc string)
+ "Process filter for pokelets.
+
+This filter implements the poke daemon message protocol, called
+pdap. PROC must be a pokelet process and is required to have the
+following attributes in its alist:
+
+ pokelet-state
+
+ One of the POKE_STATE_* values below. Initially must
+ be POKE_STATE_LENGTH.
+
+ pokelet-buf
+
+ This is a string that accumulates the input received
+ by the pokelet. Initially "".
+
+ pokelet-msg-length
+
+ Lenght of the message being processed. Initially 0.
+
+ pokelet-msg-handler
+
+ Function that gets the process, a command number
+ and a command argument. This function can error
+ if there is a protocol error."
+ (process-put proc 'pokelet-buf
+ (concat (process-get proc 'pokelet-buf) string))
+ (while (or (and (= (process-get proc 'pokelet-state) PLET_STATE_LENGTH)
+ (>= (length (process-get proc 'pokelet-buf)) 2))
+ (and (= (process-get proc 'pokelet-state) PLET_STATE_MSG)
+ (>= (length (process-get proc 'pokelet-buf))
+ (process-get proc 'pokelet-msg-length))))
+ (if (= (process-get proc 'pokelet-state) PLET_STATE_LENGTH)
+ (let ((pokelet-buf (process-get proc 'pokelet-buf)))
+ ;; The message lenght is encoded as an unsigned
+ ;; little-endian 16 bit number. Collect and skipt it.
+ (process-put proc
+ 'pokelet-msg-length
+ (logior (ash (aref pokelet-buf 1) 8)
+ (aref pokelet-buf 0)))
+ (process-put proc 'pokelet-buf (substring pokelet-buf 2))
+ ;; We are now waiting for the message data.
+ (process-put proc 'pokelet-state PLET_STATE_MSG))
+ ;; We are collecting message data.
+ (when (>= (length (process-get proc 'pokelet-buf))
+ (process-get proc 'pokelet-msg-length))
+ ;; Action on the message according to the command.
+ (let ((cmd (aref (process-get proc 'pokelet-buf) 0))
+ ;; Note we ignore the last byte of msg-data which is
+ ;; always zero.
+ (msg-data (substring (process-get proc 'pokelet-buf)
+ 1
+ (- (process-get proc 'pokelet-msg-length)
1))))
+ (apply (process-get proc 'pokelet-msg-handler) (list proc cmd
msg-data)))
+ ;; Discard used portion of the buffer and go back to waiting
+ ;; for a message length.
+ (process-put proc
+ 'pokelet-buf
+ (substring (process-get proc 'pokelet-buf)
+ (process-get proc 'pokelet-msg-length)))
+ (process-put proc 'pokelet-state PLET_STATE_LENGTH)))))
+
+(defun poke-make-pokelet-process-new (name ctrl msg-handler)
+ (let ((proc (make-network-process :name name
+ :buffer (concat "*" name "*")
+ :family 'local
+ :service poked-socket)))
+ (process-put proc 'pokelet-state PLET_STATE_LENGTH)
+ (process-put proc 'pokelet-buf "")
+ (process-put proc 'pokelet-msg-length 0)
+ (process-put proc 'pokelet-msg-handler msg-handler)
+ (set-process-query-on-exit-flag proc nil)
+ (set-process-filter proc #'poke-pokelet-filter)
+ (set-process-filter-multibyte proc nil)
+ (process-send-string proc ctrl)
+ proc))
+
+(defun poke-make-pokelet-process (name ctrl)
+ (let ((proc (make-network-process :name name
+ :buffer (concat "*" name "*")
+ :family 'local
+ :service poked-socket)))
+ (process-send-string proc ctrl)
+ proc))
+
+;;;; poke-out pokelet
+
+(defconst poke-out-iter-string
+ (propertize (char-to-string 8594) 'font-lock-face 'poke-iter-string-face))
+
+(defvar poke-out-process nil)
+
+(defun poke-out-stylize (styles string)
+ (let ((propertized-string string))
+ (mapcar (lambda (style)
+ (let* ((face-ass (assoc style poke-styling-faces))
+ (face (when face-ass (cadr face-ass))))
+ (setq propertized-string
+ (if face
+ (propertize propertized-string 'font-lock-face face)
+ propertized-string))))
+ (reverse styles))
+ propertized-string))
+
+(defun poke-out-handle-cmd (proc cmd data)
+ (pcase cmd
+ (1 ;; Iteration begin
+ (process-put proc 'poke-out-eval "")
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (process-put proc 'poke-out-iter-begin (point))))))
+ (3 ;; Iteration end
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (save-excursion
+ (unless (equal (process-get proc 'poke-out-iter-begin)
+ (point-max))
+ (narrow-to-region (process-get proc 'poke-out-iter-begin)
+ (point-max)))
+ (let ((buffer-read-only nil))
+ (mapcar (lambda (window)
+ (set-window-point window (point-min)))
+ (get-buffer-window-list))))))
+ (process-put proc 'poke-out-emitted-iter-string nil)
+ (when (process-live-p poke-repl-process)
+ (poke-repl-end-of-iteration (process-get proc 'poke-out-eval))))
+ (2 ;; Process terminal poke output
+ (let ((output (poke-out-stylize
+ (process-get proc 'poke-out-styles) data)))
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (unless (process-get proc 'poke-out-emitted-iter-string)
+ (insert (concat poke-out-iter-string "\n"))
+ (process-put proc 'poke-out-emitted-iter-string t))
+ (insert output)))))))
+ (6 ;; Process eval poke output
+ (let ((output (poke-out-stylize
+ (process-get proc 'poke-out-styles) data)))
+ ;; Append the output to the global variable which will be
+ ;; handled at the end of the iteration.
+ (process-put proc 'poke-out-eval
+ (concat (process-get proc 'poke-out-eval) output))
+ ;; If there is no repl, output this in the *poke-out*
+ ;; buffer prefixed with >
+ (when (not (process-live-p poke-repl-process))
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (insert (concat ">" output))))))))
+ (7 ;; Error output
+ (let ((output (poke-out-stylize
+ (process-get proc 'poke-out-styles) data)))
+ ;; Append to the eval output for now.
+ (process-put proc 'poke-out-eval
+ (concat (process-get proc 'poke-out-eval) output))
+ ;; If there is no repl, output this in the *poke-out*
+ ;; buffer prefixed with error>
+ (when (not (process-live-p poke-repl-process))
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (insert (concat "error>" output))))))))
+ (4 ;; Styling class begin
+ (let ((style data))
+ (process-put proc
+ 'poke-out-styles
+ (cons style (process-get proc 'poke-out-styles)))))
+ (5 ;; Styling class end
+ (let ((style data)
+ (styles (process-get proc 'poke-out-styles)))
+ (if (or (not styles)
+ (not (equal (car styles) style)))
+ (error "closing a mismatched style")
+ (process-put proc
+ 'poke-out-styles (cdr styles)))))
+ (_ ;; Protocol error
+ (process-put proc 'pokelet-buf "")
+ (process-put proc 'pokelet-msg-length 0)
+ (error "pokelet protocol error"))))
+
+(defvar poke-out-font-lock nil
+ "Font lock entries for `poke-vu-mode'.")
+
+(defun poke-out-mode ()
+ "A major mode for Poke out buffers.
+
+Commands:
+\\{poke-out-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq poke-out-mode-map (make-keymap))
+ (use-local-map poke-out-mode-map)
+ (setq-local font-lock-defaults '(poke-out-font-lock))
+ (setq mode-name "poke-out")
+ (setq major-mode 'poke-out-mode)
+ (read-only-mode t))
+
+(defun poke-out ()
+ (interactive)
+ (when (not (process-live-p poke-out-process))
+ (setq poke-out-process
+ (poke-make-pokelet-process-new "poke-out" "\x81"
+ #'poke-out-handle-cmd))
+ (process-put poke-out-process 'poke-out-styles nil)
+ (process-put poke-out-process 'poke-out-iter-begin 1)
+ (process-put poke-out-process 'poke-out-eval nil)
+ (process-put poke-out-process 'poke-out-emitted-iter-string nil)
+ (save-excursion
+ (set-buffer "*poke-out*")
+ (poke-out-mode)))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-out*")))
+
+;;;; poke-cmd pokelet
+
+(defvar poke-cmd-process nil)
+
+(defun poke-cmd-send (string)
+ ;; Send the lenght of string in a 16-bit little-endian unsigned
+ ;; integer, followed by string, to poke-cmd-process.
+ (if (process-live-p poke-cmd-process)
+ (progn
+ (let* ((string-length (length string)))
+ (process-send-string poke-cmd-process
+ (unibyte-string (logand string-length #xff)
+ (logand (ash string-length -8)
#xff)))
+ (process-send-string poke-cmd-process string)))
+ (error "poke-cmd is not running")))
+
+(defun poke-cmd ()
+ (interactive)
+ (when (not (process-live-p poke-cmd-process))
+ (setq poke-cmd-process (poke-make-pokelet-process
+ "poke-cmd" "\x02"))
+ (set-process-query-on-exit-flag poke-cmd-process nil))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-cmd*")))
+
+;;;; poke-code pokelet
+
+(defvar poke-code-process nil)
+
+(defun poke-code-send (string)
+ ;; Send the lenght of string in a 16-bit little-endian unsigned
+ ;; integer, followed by string, to poke-code-process.
+ (if (process-live-p poke-code-process)
+ (progn
+ (let* ((string-length (length string)))
+ (process-send-string poke-code-process
+ (unibyte-string (logand string-length #xff)
+ (logand (ash string-length -8)
#xff)))
+ (process-send-string poke-code-process string)))
+ (error "poke-code is not running")))
+
+(defun poke-code-cmd-send-code ()
+ "Execute Poke code."
+ (interactive)
+ (let ((code-begin (or (save-excursion (re-search-backward "^//--$" nil t))
+ (point-min)))
+ (code-end (or (save-excursion (re-search-forward "^//--$" nil t))
+ (point-max))))
+ (poke-code-send (buffer-substring code-begin code-end)))
+ ;; XXX only do this if this not the only window in the frame.
+ (when (window-parent)
+ (delete-window)))
+
+(defvar poke-code-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'poke-code-cmd-send-code)
+ map))
+
+(define-derived-mode poke-code-mode poke-mode "poke-code"
+ "A major mode for Poke code.
+
+Commands:
+\\<poke-code-mode-map>
+\\{poke-code-mode-map}"
+)
+
+(defun poke-code ()
+ (interactive)
+ (when (not (process-live-p poke-code-process))
+ (setq poke-code-process (poke-make-pokelet-process
+ "poke-code" "\x01"))
+ (set-process-query-on-exit-flag poke-code-process nil)
+ (save-excursion
+ (set-buffer "*poke-code*")
+ (poke-code-mode)
+ (goto-char (point-min))
+ (insert "/* This is a Poke evaluation buffer.\n"
+ " Press C-cC-c to evaluate. */\n")))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-code*")))
+
+;;;; poke-vu pokelet
+
+(defvar poke-vu-process nil)
+
+(defun poke-vu-handle-cmd (proc cmd data)
+ (pcase cmd
+ (1 ;; CLEAR
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((buffer-read-only nil))
+ (setq-local poke-vu-cur-pos (point))
+ (delete-region (point-min) (point-max))))))
+ (2 ;; APPEND
+ (process-put proc 'poke-vu-output
+ (concat (process-get proc 'poke-vu-output) data)))
+ (5 ;; FINISH
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let* ((buffer-read-only nil)
+ (current-pos (buffer-local-value 'poke-vu-cur-pos
+ (current-buffer))))
+ (insert (process-get proc 'poke-vu-output))
+ (goto-char current-pos)
+ (mapcar (lambda (window)
+ (set-window-point window current-pos))
+ (get-buffer-window-list))
+ (let ((offset (poke-vu-byte-at-point)))
+ (when offset
+ (poke-vu-goto-byte offset))))))
+ (process-put proc 'poke-vu-output ""))
+ (3 ;; HIGHLIGHT
+ )
+ (4 ;; FILTER
+ )
+ (_ ;; Protocol error
+ (process-put proc 'pokelet-buf "")
+ (process-put proc 'pokelet-msg-length 0)
+ (error "pokelet protocol error"))))
+
+(defvar poke-vu-font-lock
+ `(("^[0-9a-zA-Z]+:" . 'poke-vu-addr-face)
+ (" .*$" . 'poke-vu-ascii-face)
+ )
+ "Font lock entries for `poke-vu-mode'.")
+
+(defun poke-vu-cmd-beginning-of-buffer ()
+ (interactive)
+ (setq start-byte-offset 0)
+ (poke-vu-refresh)
+ (poke-vu-goto-byte 0))
+
+(defun poke-vu-cmd-previous-line ()
+ (interactive)
+ (if (equal (line-number-at-pos) 1)
+ (progn
+ (setq-local start-byte-offset (- start-byte-offset #x10))
+ (poke-vu-refresh))
+ (previous-line))
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte offset))))
+
+(defun poke-vu-cmd-next-line ()
+ (interactive)
+ (if (save-excursion
+ (end-of-line)
+ (forward-char)
+ (eobp))
+ (progn
+ (setq-local start-byte-offset (+ start-byte-offset #x10))
+ (poke-vu-refresh)
+ (end-of-buffer)
+ (previous-line))
+ (next-line))
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte offset))))
+
+(defun poke-vu-cmd-page-down ()
+ (interactive)
+ (save-excursion
+ (let ((window (get-buffer-window (current-buffer))))
+ (setq-local start-byte-offset
+ (+ start-byte-offset (* (- (window-height) 1) #x10)))
+ (poke-vu-refresh)))
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte offset))))
+
+(defun poke-vu-cmd-page-up ()
+ (interactive)
+ (save-excursion
+ (let ((window (get-buffer-window (current-buffer))))
+ (setq-local start-byte-offset
+ (- start-byte-offset (* (- (window-height) 1) #x10)))
+ (poke-vu-refresh)))
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte offset))))
+
+(defconst poke-vu-bytes-per-line 16)
+
+(defun poke-vu-bol-byte ()
+ "Return the byte offset of the first byte in the current line."
+ (+ start-byte-offset
+ (* (- (line-number-at-pos) 1) poke-vu-bytes-per-line)))
+
+(defun poke-vu-byte-at-point ()
+ "Return the byte offset at the current point in the *poke-vu* buffer."
+ (let ((bol-byte (poke-vu-bol-byte))
+ (column (- (point) (save-excursion
+ (beginning-of-line)
+ (point)))))
+ (pcase column
+ ;; Too tired now to get an algebraic solution for this.
+ (10 (+ bol-byte 0)) (12 (+ bol-byte 1)) (15 (+ bol-byte 2))
+ (17 (+ bol-byte 3)) (20 (+ bol-byte 4)) (22 (+ bol-byte 5))
+ (25 (+ bol-byte 6)) (27 (+ bol-byte 7)) (30 (+ bol-byte 8))
+ (32 (+ bol-byte 9)) (35 (+ bol-byte 10)) (37 (+ bol-byte 11))
+ (40 (+ bol-byte 12)) (42 (+ bol-byte 13)) (45 (+ bol-byte 14))
+ (47 (+ bol-byte 15))
+ (_ nil))))
+
+(defun poke-vu-byte-pos (offset)
+ "Return the position in the current poke-vu buffer
+corresponding to the given offset.
+
+If the current buffer is not showing the given byte offset,
+return nil."
+ (when (and (>= offset start-byte-offset)
+ (<= offset (+ start-byte-offset
+ (* (count-lines (point-min) (point-max))
+ poke-vu-bytes-per-line))))
+ (save-excursion
+ (let ((lineno (+ (/ (- offset start-byte-offset)
+ poke-vu-bytes-per-line)
+ 1)))
+ (goto-line lineno)
+ (let* ((lineoffset (- offset (poke-vu-bol-byte)))
+ (column (+ 10
+ (* 2 lineoffset)
+ (/ lineoffset 2))))
+ (forward-char column)
+ (point))))))
+
+(defun poke-vu-remove-highlight ()
+ (remove-overlays (point-min) (point-max)
+ 'face 'poke-vu-highlighted-byte-face))
+
+(defun poke-vu-goto-byte (offset)
+ "Move the pointer to the beginning of the byte at OFFSET
+relative to the beginning of the shown IO space."
+ (let ((byte-pos (poke-vu-byte-pos offset)))
+ (unless byte-pos
+ ;; Scroll so the desired byte is in the first line.
+ (setq start-byte-offset (- offset
+ (% offset poke-vu-bytes-per-line)))
+ (poke-vu-refresh)
+ (setq byte-pos (poke-vu-byte-pos offset)))
+ ;; Move the point where the byte at the given offset is.
+ (goto-char byte-pos)
+ ;; Update selected-byte overlays
+ (remove-overlays (point-min) (point-max)
+ 'face 'poke-vu-selected-byte-face)
+ (overlay-put (make-overlay (point) (+ (point) 2))
+ 'face 'poke-vu-selected-byte-face)
+ (let ((ascii-point (+
+ (save-excursion (beginning-of-line) (point))
+ 50 (- offset (poke-vu-bol-byte))
+ 1)))
+ (overlay-put (make-overlay ascii-point (+ ascii-point 1))
+ 'face 'poke-vu-selected-byte-face)))
+ (message (format "0x%x#B" offset)))
+
+(defun poke-vu-cmd-goto-byte (offset)
+ (interactive "nGoto byte: ")
+ (poke-vu-goto-byte offset))
+
+(defun poke-vu-cmd-backward-char ()
+ (interactive)
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte
+ (if (equal offset 0) 0 (- offset 1)))
+ (backward-char))))
+
+(defun poke-vu-cmd-forward-char ()
+ (interactive)
+ (let ((offset (poke-vu-byte-at-point)))
+ (if offset
+ (poke-vu-goto-byte (+ offset 1))
+ (forward-char))))
+
+(defun poke-vu-cmd-move-beginning-of-line ()
+ (interactive)
+ (poke-vu-goto-byte (poke-vu-bol-byte)))
+
+(defun poke-vu-cmd-move-end-of-line ()
+ (interactive)
+ (poke-vu-goto-byte (1- (+ (poke-vu-bol-byte)
+ poke-vu-bytes-per-line))))
+
+(defun poke-vu-cmd-copy-byte-offset-as-kill ()
+ (interactive)
+ (let ((offset (poke-vu-byte-at-point)))
+ (when offset
+ (let ((string (format "0x%x#B" offset)))
+ (if (eq last-command 'kill-region)
+ (kill-append string nil)
+ (kill-new string))
+ (message "%s" string)))))
+
+(defun poke-vu-mode ()
+ "A major mode for Poke vu output.
+
+Commands:
+\\{poke-vu-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq poke-vu-mode-map (make-keymap))
+ (use-local-map poke-vu-mode-map)
+ (define-key poke-vu-mode-map "\C-v" 'poke-vu-cmd-page-down)
+ (define-key poke-vu-mode-map "\M-v" 'poke-vu-cmd-page-up)
+ (define-key poke-vu-mode-map "\C-a" 'poke-vu-cmd-move-beginning-of-line)
+ (define-key poke-vu-mode-map "\C-e" 'poke-vu-cmd-move-end-of-line)
+ (define-key poke-vu-mode-map "\C-b" 'poke-vu-cmd-backward-char)
+ (define-key poke-vu-mode-map "\C-f" 'poke-vu-cmd-forward-char)
+ (define-key poke-vu-mode-map "\M-<" 'poke-vu-cmd-beginning-of-buffer)
+ (define-key poke-vu-mode-map "\C-p" 'poke-vu-cmd-previous-line)
+ (define-key poke-vu-mode-map "\C-n" 'poke-vu-cmd-next-line)
+ (define-key poke-vu-mode-map "\C-cg" 'poke-vu-cmd-goto-byte)
+ (define-key poke-vu-mode-map "w" 'poke-vu-cmd-copy-byte-offset-as-kill)
+ (setq-local font-lock-defaults '(poke-vu-font-lock))
+ (setq-local start-byte-offset 0)
+ (setq-local header-line-format
+ "76543210 0011 2233 4455 6677 8899 aabb ccdd eeff
0123456789ABCDEF")
+ (setq mode-name "poke-vu")
+ (setq major-mode 'poke-vu-mode)
+ (read-only-mode t))
+
+(defun poke-vu ()
+ (interactive)
+ (when (not (process-live-p poke-vu-process))
+ (setq poke-vu-process
+ (poke-make-pokelet-process-new "poke-vu" "\x82"
+ #'poke-vu-handle-cmd))
+ (process-put poke-vu-process 'poke-vu-output "")
+ (save-excursion
+ (set-buffer "*poke-vu*")
+ (poke-vu-mode)))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-vu*")))
+
+(defun poke-vu-erase ()
+ (let ((buffer (get-buffer "*poke-vu*")))
+ (when (and (process-live-p poke-vu-process)
+ buffer)
+ (let ((buffer-read-only nil))
+ (delete-region (point-min) (point-max))))))
+
+(defun poke-vu-refresh ()
+ "Return the Poke code to send in order to refresh the poke-vu
+buffer."
+ (let* ((buffer (get-buffer "*poke-vu*"))
+ (window (get-buffer-window buffer)))
+ (when (and (process-live-p poke-vu-process)
+ window)
+ (poke-code-send (format
+ "poke_el_vu_from = %s#B; poke_el_vu_size = %s#B;
poke_el_vu_refresh;"
+ (number-to-string
+ (buffer-local-value 'start-byte-offset buffer))
+ (number-to-string (* (- (window-height window) 2)
+ #x10)))))))
+
+(add-hook 'window-size-change-functions
+ (lambda (window)
+ (let (buffer (window-buffer window))
+ (when (equal (buffer-name buffer) "*poke-vu*")
+ (poke-vu-refresh)))))
+
+;;;; poke-complete
+
+(defvar poke-complete-process nil)
+
+(defvar poke-complete-alternatives nil)
+
+(defun poke-complete-handle-cmd (proc cmd data)
+ (pcase cmd
+ (1 ; Complete identifier: variable, type, function, unit.
+ (let ((alternatives nil))
+ (with-current-buffer (process-buffer proc)
+ (delete-region (point-min) (point-max))
+ (insert data)
+ ;; Note the trailing NULL was removed by the protocol
+ ;; handler.
+ (insert "\0")
+ ;; Skip the completion string itself.
+ (goto-char (point-min))
+ (search-forward "\0" nil t)
+ ;; Now collect the rest of the strings.
+ (let ((pos (point)))
+ (while (search-forward "\0" nil t)
+ (setq alternatives
+ (cons
+ (buffer-substring pos (- (point) 1))
+ alternatives))
+ (setq pos (point)))))
+ (setq poke-complete-alternatives alternatives)
+ (when (process-live-p poke-repl-process)
+ (with-current-buffer (process-buffer poke-repl-process)
+ (completion-in-region poke-repl-complete-begin
+ poke-repl-complete-end
+ poke-complete-alternatives)))))
+ (2 ; Complete IO space. Unused
+ )
+ (_ ;; Protocol error
+ (process-put proc 'pokelet-buf "")
+ (process-put proc 'pokelet-msg-length 0)
+ (error "pokelete protocol error"))))
+
+(defun poke-complete ()
+ (interactive)
+ (when (not (process-live-p poke-complete-process))
+ (poke-code)
+ (setq poke-complete-process
+ (poke-make-pokelet-process-new "poke-complete" "\x85"
+ #'poke-complete-handle-cmd))))
+
+;;;; poke-elval
+
+(defconst poke-elval-init-pk
+ "\
+var PLET_ELVAL_CMD_EVAL = 0UB;
+
+fun plet_elval = (string s) void:
+{
+ var c = byte[s'length] ();
+
+ stoca (s, c);
+ poked_chan_send (100, [PLET_ELVAL_CMD_EVAL] + c);
+}
+")
+
+(defvar poke-elval-process nil)
+
+(defun poke-elval-handle-cmd (proc cmd data)
+ (pcase cmd
+ (0 ;; EVAL
+ (ignore-errors
+ (eval (car (read-from-string data)))))
+ (_ ;; Protocol error
+ (process-put proc 'pokelet-buf "")
+ (process-put proc 'pokelet-msg-lenght 0)
+ (error "pokelet protocol error"))))
+
+(defun poke-elval ()
+ (interactive)
+ (when (not (process-live-p poke-elval-process))
+ (poke-code)
+ (poke-code-send poke-elval-init-pk)
+ (setq poke-elval-process
+ (poke-make-pokelet-process-new "poke-elval" "\xe4"
+ #'poke-elval-handle-cmd))))
+
+;;;; poke-repl
+
+(defconst poke-repl-default-prompt "#!poke!# ")
+(defvar poke-repl-prompt poke-repl-default-prompt)
+(defvar poke-repl-process nil)
+
+(defvar poke-repl-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "\C-ci") 'poke-ios)
+ (define-key map (kbd "\C-cc") 'poke-code)
+ (define-key map (kbd "\C-cs") 'poke-settings)
+ (define-key map (kbd "\C-cm") 'poke-maps)
+ (define-key map (kbd "\C-cv") 'poke-vu)
+ (define-key map (kbd "\C-cV") 'poke-vu-refresh)
+ map)
+ "Local keymap for `poke-repl-mode' buffers.")
+
+(define-derived-mode poke-repl-mode comint-mode "poke"
+ "Major mode for the poke repl.
+\\<poke-repl-mode-map>
+\\{poke-repl-mode-map}"
+ (setq comint-prompt-regexp (concat "^" (regexp-quote poke-repl-prompt)))
+ (setq comint-input-sender 'poke-repl-input-sender)
+ (setq poke-repl-process
+ (condition-case nil
+ (start-process "poke-repl-process" (current-buffer) "hexl")
+ (file-error (start-process "poke-repl-process" (current-buffer)
"cat"))))
+ (set-process-query-on-exit-flag poke-repl-process nil)
+ (set-marker
+ (process-mark poke-repl-process) (point))
+ (add-to-list 'comint-dynamic-complete-functions
+ #'poke-repl-complete-symbol)
+ (comint-output-filter poke-repl-process poke-repl-prompt))
+
+(defvar poke-repl-complete-begin nil)
+(defvar poke-repl-complete-end nil)
+
+(defun poke-repl-complete-symbol ()
+ (let ((symbol (or (comint-word "a-zA-Z._'")
+ "")))
+ (when symbol
+ (setq poke-repl-complete-begin (match-beginning 0))
+ (setq poke-repl-complete-end (match-end 0))
+ (poke-code-send (concat "plet_autocomplete (1, "
+ "\"" symbol "\""
+ ");")))))
+
+(defun poke-repl-end-of-iteration (valstring)
+ (with-current-buffer "*poke-repl*"
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (if
+ (re-search-backward
+ (regexp-quote (concat "-prv-"))
+ nil t)
+ (progn
+ (delete-region (point) (line-end-position))
+ (if (> (length valstring) 0)
+ (insert valstring)
+ (unless (equal (point) (point-max))
+ (delete-char 1))))
+ (message valstring))))))
+
+(defun poke-repl-set-prompt (string)
+ (let ((previous-prompt poke-repl-prompt))
+ (setq poke-repl-prompt string)
+ (when (process-live-p poke-repl-process)
+ (with-current-buffer "*poke-repl*"
+ (save-excursion
+ (re-search-backward (regexp-quote previous-prompt) nil t)
+ (delete-region (point) (line-end-position))))
+ (comint-output-filter poke-repl-process poke-repl-prompt))))
+
+(defun poke-repl-input-sender (proc input)
+ (if (not (string-blank-p input))
+ (let ((buffer-read-only nil))
+ (comint-output-filter poke-repl-process "-prv-\n")
+ (comint-output-filter poke-repl-process poke-repl-prompt)
+ (cond
+ ((string-match "^[ \t]*\\(var\\|type\\|unit\\|fun\\) " input)
+ (poke-code-send (concat input ";")))
+ ((string-match "^[ \t]*@ \\(.*\\)" input)
+ (poke-code-send (concat "poke_el_map ("
+ "\"" (match-string 1 input) "\""
+ ");")))
+ ((string-match "^[ \t]*= \\(.*\\)" input)
+ (poke-code-send (concat "poke_el_edit ("
+ "\"" (match-string 1 input) "\""
+ ");")))
+ (t
+ (poke-cmd-send (concat input ";")))))
+ (comint-output-filter poke-repl-process poke-repl-prompt)))
+
+(defun poke-repl ()
+ (interactive)
+ (poke-out)
+ (poke-cmd)
+ (poke-code)
+ (poke-complete)
+ (when (not (process-live-p poke-repl-process))
+ (let ((buf (get-buffer-create "*poke-repl*")))
+ (with-current-buffer buf
+ (poke-repl-mode)))
+ (poke-code-send "poke_el_banner;"))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-repl*")))
+
+;;;; poke-ios
+
+(defvar poke-ios-alist nil
+ "List of IO spaces currently open.")
+
+(defvar-local poke-ios-overlay nil
+ "The overlay on a highlighted poke-ios line.")
+
+(defun poke-ios-update-overlay ()
+ (unless poke-ios-overlay
+ (setq poke-ios-overlay (make-overlay (point) (point))))
+ (move-overlay poke-ios-overlay
+ (line-beginning-position)
+ (line-end-position))
+ (overlay-put poke-ios-overlay 'face 'highlight))
+
+(defun poke-ios-open (ios iohandler ioflags iosize)
+ (unless (assoc ios poke-ios-alist)
+ (setq poke-ios-alist (cons (list ios iohandler ioflags iosize)
+ poke-ios-alist)))
+ (poke-ios-populate))
+
+(defun poke-ios-close (ios)
+ (setq poke-ios-alist (assq-delete-all ios poke-ios-alist))
+ (poke-ios-populate)
+ ;; If there is no more open IO spaces, set the *poke-repl* prompt
+ ;; to the default value, also delete the *poke-vu* buffer if it
+ ;; exists.
+ (when (equal (length poke-ios-alist) 0)
+ (poke-repl-set-prompt poke-repl-default-prompt)
+ (poke-vu-erase)))
+
+(defun poke-ios-set (ios)
+ ;; Select the right line in *poke-ios*.
+ ;; XXX
+ ;; Change prompt in *poke-repl*.
+ (let ((ios-data (assoc ios poke-ios-alist)))
+ (when ios-data
+ (poke-repl-set-prompt (concat "#!" (cadr ios-data) "!# "))))
+ ;; Update VU
+ (poke-vu-refresh))
+
+(defvar poke-ios-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [return] 'poke-ios-cmd-set-ios)
+ (define-key map (kbd "RET") 'poke-ios-cmd-set-ios)
+ (define-key map (kbd "n") 'poke-ios-cmd-next)
+ (define-key map (kbd "p") 'poke-ios-cmd-prev)
+ map)
+ "Local keymap for `poke-ios-mode' buffers.")
+
+(define-derived-mode poke-ios-mode tabulated-list-mode "poke-ios"
+ "Major mode for summarizing the open IO spaces in poke.
+\\<poke-ios-mode-map>
+\\{poke-ios-mode-map}"
+ (setq tabulated-list-format nil)
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key nil)
+ (tabulated-list-init-header))
+
+(defun poke-ios-cmd-set-ios ()
+ "Set the current IOS in poke to the entry selected in the
+*poke-ios* buffer."
+ (interactive)
+ (let ((ios-id (tabulated-list-get-id)))
+ (poke-code-send (concat "set_ios (" (number-to-string ios-id) ");")))
+ (poke-ios-update-overlay))
+
+(defun poke-ios-cmd-next ()
+ "Move to the next line in the poke-ios buffer."
+ (interactive)
+ (forward-line 1)
+ (poke-ios-update-overlay))
+
+(defun poke-ios-cmd-prev ()
+ "Move to the previous line in the poke-ios buffer."
+ (interactive)
+ (forward-line -1)
+ (poke-ios-update-overlay))
+
+(defun poke-ios-populate ()
+ "Populate a `poke-ios-mode' buffer with the data in `poke-ios-alist."
+ (when (get-buffer "*poke-ios*")
+ (save-excursion
+ (set-buffer "*poke-ios*")
+ (let ((headers [("Id" 5 t) ("Handler" 10 nil) ("Flags" 8 nil)
+ ("Size" 6 t)])
+ (entries (mapcar
+ (lambda (ios)
+ (let ((ios-id (car ios))
+ (ios-handler (cadr ios))
+ (ios-flags (caddr ios))
+ (ios-size (cadddr ios)))
+ (list ios-id (vector (number-to-string ios-id)
+ ios-handler
+ ios-flags
+ (concat (number-to-string
ios-size) "#B")))))
+ poke-ios-alist)))
+ (setq tabulated-list-format headers)
+ (setq tabulated-list-padding 2)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries (reverse entries))
+ (tabulated-list-print nil)
+ (goto-char (point-min))
+ (poke-ios-update-overlay)))))
+
+(defun poke-ios ()
+ (interactive)
+ (let ((buf (get-buffer-create "*poke-ios*")))
+ (with-current-buffer buf
+ (poke-ios-mode)
+ (poke-ios-populate)
+ (poke-ios-update-overlay)))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-ios*")))
+
+;;;; poke-edit
+
+(defun poke-edit (name)
+ (poke-code-send (concat "poke_el_edit_1 ("
+ "\"" name "\", "
+ name ", "
+ "typeof (" name "));")))
+
+(defun poke-edit-1 (name type typekind elems)
+ (let ((elem-names "")
+ (elem-values ""))
+ (mapcar
+ (lambda (ename)
+ (setq elem-names (concat elem-names "\"" ename "\",")))
+ elems)
+ (mapcar
+ (lambda (ename)
+ (setq elem-values (concat elem-values "format (\"%Tv\", "
+ "(" name ")"
+ (if (equal (aref ename 0) ?\[) "" ".")
+ ename "),")))
+ elems)
+ (poke-code-send
+ (concat "poke_el_edit_2 ("
+ "\"" name "\", "
+ name ", "
+ "typeof (" name "), "
+ "[" elem-names "], "
+ "[" elem-values "]);"))))
+
+(defun poke-edit-2 (name type typekind elem-names elem-values)
+ (let ((buf (get-buffer-create "*poke-edit*")))
+ (with-current-buffer buf
+ (poke-edit-mode)
+ (setq-local edit-name name)
+ (setq-local edit-type type)
+ (setq-local edit-typekind typekind)
+ (setq-local edit-elem-names elem-names)
+ (setq-local edit-elem-values elem-values)
+ (poke-edit-do-buffer)
+ (when (not (get-buffer-window "*poke-edit*"))
+ (switch-to-buffer-other-window "*poke-edit*")))))
+
+(defvar poke-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-keymap)
+ (define-key map (kbd "q") 'quit-window)
+ map))
+
+(defun poke-edit-mode ()
+ "Major mode for editing Poke values."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map poke-edit-mode-map))
+
+(defun poke-edit-do-buffer ()
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (remove-overlays)
+ (widget-insert (concat (propertize edit-name
+ 'font-lock-face
+ 'poke-edit-header-face)
+ " = "
+ edit-type
+ "\n"))
+ (widget-insert (concat " "
+ (pcase edit-typekind
+ ("struct" "{")
+ ("array" "[")
+ (_ ""))
+ "\n"))
+ (mapcar*
+ (lambda (elem-name elem-value)
+ (widget-create 'editable-field
+ :size 2
+ :format (concat " "
+ (propertize elem-name
+ 'font-lock-face
+ 'poke-struct-field-name-face)
"=" "%v,")
+ :action `(lambda (widget event)
+ (poke-code-send
+ (concat "(" ,edit-name ")"
+ (if (equal ,edit-typekind "struct")
+ "."
+ "")
+ ,elem-name
+ " = "
+ (widget-value widget)
+ ";"
+ "plet_elval
(\"(poke-edit-after)\");")))
+ elem-value)
+ (widget-insert "\n"))
+ edit-elem-names
+ edit-elem-values)
+ (widget-insert (concat " " (pcase edit-typekind
+ ("struct" "}")
+ ("array" "]")
+ (_ ""))
+ "\n"))
+ (widget-setup)
+ (goto-char (point-min)))
+
+(defun poke-edit-after ()
+ "This function is called after an edition value has been changed."
+ (poke-vu-refresh)
+ (let ((buf (get-buffer "*poke-edit*")))
+ (set-buffer buf)
+ (poke-edit edit-name)))
+
+;;;; poke-maps
+
+(defvar poke-maps-stack '(nil)
+ "Stack of map listings.
+Each entry in the stack is a list of strings, and may be empty.")
+
+(defun poke-maps-add-var (name)
+ (let ((n (if (and (string-match " " name)
+ (not (string-match "\\." name)))
+ (concat "(" name ")")
+ name)))
+ (poke-code-send (concat "poke_el_map_1 ("
+ "\"" n "\", "
+ n ", "
+ "typeof (" n "));"))))
+
+(defun poke-maps-add-elems (name)
+ (poke-code-send (concat "poke_el_map_elems ("
+ "\"" name "\", "
+ name ", "
+ "typeof (" name "));")))
+
+(defun poke-maps-add (name type offset)
+ "Add a new entry in the current map listing."
+ (setq poke-maps-stack
+ (cons
+ (cons
+ (list nil name type offset)
+ (car poke-maps-stack))
+ (cdr poke-maps-stack)))
+ (let ((buf (get-buffer-create "*poke-maps*")))
+ (with-current-buffer buf
+ (poke-maps-do-buffer)))
+ (when (not (get-buffer-window "*poke-maps*"))
+ (switch-to-buffer-other-window "*poke-maps*")))
+
+(defun poke-maps-do-buffer ()
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (remove-overlays)
+ (poke-maps-mode)
+ (poke-maps-populate)
+ (poke-maps-do-line))
+
+(defun poke-maps-populate ()
+ "Populate a `poke-maps-mode' buffer with the map listing
+at the top of the `poke-maps-stack' stack."
+ (when (get-buffer "*poke-maps*")
+ (save-excursion
+ (set-buffer "*poke-maps*")
+ (let ((headers [("" 3 nil) ("Offset" 20 nil) ("Name" 30 nil)])
+ (entries (mapcar
+ (lambda (map)
+ (let ((map-mark (if (car map) "#" ""))
+ (map-name (cadr map))
+ (map-type (caddr map))
+ (map-offset (cadddr map)))
+ (list map-name (vector map-mark
+ (if (equal (% map-offset 8) 0)
+ (format "0x%08x#B" (/
map-offset 8))
+ (format "0x%016x#b"
map-offset))
+ map-name
+ ))))
+ (car poke-maps-stack))))
+ (setq tabulated-list-format headers)
+ (setq tabulated-list-padding 2)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries entries)
+ (tabulated-list-print nil)))))
+
+(defun poke-maps-do-line ()
+ (poke-maps-update-overlay)
+ (let ((name (tabulated-list-get-id)))
+ (when name
+ (poke-code-send (concat "printf \"%Tv\","
+ (tabulated-list-get-id)
+ ";")))))
+
+(defun poke-maps-cmd-next ()
+ "Move to the next line in the *poke-maps* buffer."
+ (interactive)
+ (forward-line 1)
+ (poke-maps-do-line))
+
+(defun poke-maps-cmd-prev ()
+ "Move to the previous line in the *poke-maps* buffer."
+ (interactive)
+ (previous-line 1)
+ (poke-maps-do-line))
+
+(defun poke-maps-cmd-sub ()
+ (interactive)
+ (let ((name (tabulated-list-get-id)))
+ (when name
+ (setq poke-maps-stack (cons 'nil poke-maps-stack))
+ (poke-maps-add-elems name))))
+
+(defun poke-maps-cmd-parent ()
+ (interactive)
+ (if (equal (length poke-maps-stack) 1)
+ (message "At the top-level.")
+ (setq poke-maps-stack (cdr poke-maps-stack))
+ (poke-maps-populate)
+ (poke-maps-do-line)))
+
+(defun poke-maps-cmd-edit ()
+ (interactive)
+ (let ((var (tabulated-list-get-id)))
+ (poke-edit var)))
+
+(defun poke-maps-cmd-scroll-out-up ()
+ (interactive)
+ (let ((buf (get-buffer "*poke-out*"))
+ (cur-window (get-buffer-window)))
+ (when buf
+ (save-excursion
+ (set-buffer buf)
+ (ignore-errors
+ (mapcar (lambda (window)
+ (select-window window)
+ (scroll-up))
+ (get-buffer-window-list)))
+ (select-window cur-window)))))
+
+(defun poke-maps-cmd-copy-name-as-kill ()
+ (interactive)
+ (let ((name (tabulated-list-get-id)))
+ (when name
+ (if (eq last-command 'kill-region)
+ (kill-append name nil)
+ (kill-new name))
+ (message "%s" name))))
+
+(defvar poke-maps-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'poke-maps-cmd-sub)
+ (define-key map (kbd "SPC") 'poke-maps-cmd-scroll-out-up)
+ (define-key map (kbd "u") 'poke-maps-cmd-parent)
+ (define-key map (kbd "#") 'poke-maps-cmd-mark)
+ (define-key map (kbd "n") 'poke-maps-cmd-next)
+ (define-key map (kbd "p") 'poke-maps-cmd-prev)
+ (define-key map (kbd "e") 'poke-maps-cmd-edit)
+ (define-key map (kbd "w") 'poke-maps-cmd-copy-name-as-kill)
+ map)
+ "Local keymap for `poke-maps-mode' buffer.")
+
+(define-derived-mode poke-maps-mode tabulated-list-mode "poke-maps"
+ "Major mode for listing the maps in poke.
+\\<poke-maps-mode-map>
+\\{poke-maps-mode-map}"
+ (setq tabulated-list-format nil)
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key nil)
+ (tabulated-list-init-header))
+
+(defvar-local poke-maps-overlay nil
+ "The overlay on a highlighted poke-maps line.")
+
+(defun poke-maps-update-overlay ()
+ (unless poke-maps-overlay
+ (setq poke-maps-overlay (make-overlay (point) (point))))
+ (move-overlay poke-maps-overlay
+ (line-beginning-position)
+ (line-end-position))
+ (overlay-put poke-maps-overlay 'face 'highlight))
+
+(defun poke-maps ()
+ (interactive)
+ (let ((buf (get-buffer-create "*poke-maps*")))
+ (with-current-buffer buf
+ (poke-maps-do-buffer)))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-maps*")))
+
+;;;; poke-settings
+
+(defvar poke-setting-pretty-print "no")
+(defvar poke-setting-omode "plain")
+(defvar poke-setting-omaps "no")
+(defvar poke-setting-obase 10)
+
+(defun poke-setting-set-pretty-print (val)
+ (unless (member val '("yes" "no"))
+ (error "Invalid setting for pretty-print. Expected \"yes\" or \"no\"."))
+ (poke-code-send (concat "vm_set_opprint ("
+ (if (equal val "yes") "1" "0")
+ ");")))
+
+(defun poke-setting-set-omode (val)
+ (unless (member val '("plain" "tree"))
+ (error "Invalid setting for pretty-print. Expected \"plain\" or
\"tree\"."))
+ (poke-code-send (concat "vm_set_omode ("
+ (if (equal val "plain")
+ "VM_OMODE_PLAIN"
+ "VM_OMODE_TREE")
+ ");")))
+
+(defun poke-setting-set-obase (val)
+ (unless (member val '(2 8 10 16))
+ (error "Invalid setting for obase.
+Expected 2, 8, 10 or 16."))
+ (poke-code-send (concat "vm_set_obase ("
+ (number-to-string val)
+ ");")))
+
+(defun poke-setting-set-omaps (val)
+ (unless (member val '("yes" "no"))
+ (error "Invalid setting for omaps. Expected \"yes\" or \"no\"."))
+ (poke-code-send (concat "vm_set_omaps ("
+ (if (equal val "yes") "1" "0")
+ ");")))
+
+(defun poke-init-settings ()
+ (poke-setting-set-pretty-print poke-setting-pretty-print)
+ (poke-setting-set-omode poke-setting-omode))
+
+(defvar poke-settings-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-keymap)
+ (define-key map (kbd "q") 'quit-window)
+ map))
+
+(defun poke-settings-create-widgets ()
+ (kill-all-local-variables)
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (remove-overlays)
+ (widget-insert "Output mode:\n")
+ (widget-create 'radio-button-choice
+ :value poke-setting-omode
+ :notify (lambda (widget &rest ignore)
+ (poke-setting-set-omode (widget-value widget))
+ (setq poke-setting-omode (widget-value widget)))
+ '(item "plain") '(item "tree"))
+ (widget-insert "\n")
+ (widget-insert "Output base:\n")
+ (widget-create 'radio-button-choice
+ :value poke-setting-obase
+ :notify (lambda (widget &rest ignore)
+ (poke-setting-set-obase (widget-value widget))
+ (setq poke-setting-obase (widget-value widget)))
+ '(item 2) '(item 8) '(item 10) '(item 16))
+ (widget-insert "\n")
+ (widget-insert "Pretty-print:\n")
+ (widget-create 'radio-button-choice
+ :value poke-setting-pretty-print
+ :notify (lambda (widget &rest ignore)
+ (poke-setting-set-pretty-print (widget-value
widget))
+ (setq poke-setting-pretty-print (widget-value
widget)))
+ '(item "yes") '(item "no"))
+ (widget-insert "\n")
+ (widget-insert "Output offsets:\n")
+ (widget-create 'radio-button-choice
+ :value poke-setting-omaps
+ :notify (lambda (widget &rest ignore)
+ (poke-setting-set-omaps (widget-value widget))
+ (setq poke-setting-omaps (widget-value widget)))
+ '(item "yes") '(item "no"))
+ (widget-insert "\n")
+ (use-local-map poke-settings-map)
+ (widget-setup))
+
+(defun poke-settings ()
+ (interactive)
+ (let ((buf (get-buffer "*poke-settings*")))
+ (unless buf
+ (setq buf (get-buffer-create "*poke-settings*"))
+ (with-current-buffer buf
+ (poke-settings-create-widgets))))
+ (when (called-interactively-p)
+ (switch-to-buffer-other-window "*poke-settings*")))
+
+;;;; Main interface
+
+(defconst poke-pk
+ "\
+fun poke_el_banner = void:
+{
+ print (\" _____\n\");
+ print (\" ---' __\\\\_______\n\");
+ printf (\" ______) Emacs meets GNU poke %s\n\",
poked_libpoke_version);
+ print (\" __)\n\");
+ print (\" __)\n\");
+ print (\" ---._______)\n\");
+ print (\"\n\");
+ print (\"Copyright (C) 2022 Jose E. Marchesi.
+License GPLv3+: GNU GPL version 3 or later.\n\n\");
+ print (\"This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.\n\");
+}
+
+var poke_el_vu_from = 0#B;
+var poke_el_vu_size = 0#B;
+
+fun poke_el_vu_refresh = void:
+{
+ try
+ plet_vu :from poke_el_vu_from
+ :size poke_el_vu_size;
+ catch if E_no_ios {};
+}
+
+poked_after_cmd_hook += [(poke_el_vu_refresh)];
+
+fun poke_el_ios_open = (int<32> ios) void:
+{
+ var flags = ioflags (ios);
+ var flags_str = \"\";
+
+ flags_str += flags & IOS_F_READ ? \"r\" : \" \";
+ flags_str += flags & IOS_F_WRITE ? \"w\" : \" \";
+ var cmd = format (\"(poke-ios-open %i32d %v \\\"%s\\\" %u64d)\",
+ ios, iohandler (ios), flags_str, iosize (ios)/#B);
+ plet_elval (cmd);
+}
+
+fun poke_el_ios_close = (int<32> ios) void:
+{
+ var cmd = format (\"(poke-ios-close %i32d)\", ios);
+ plet_elval (cmd);
+}
+
+fun poke_el_ios_set = (int<32> ios) void:
+{
+ var cmd = format (\"(poke-ios-set %i32d)\", ios);
+ plet_elval (cmd);
+}
+
+ios_open_hook += [poke_el_ios_open];
+ios_close_hook += [poke_el_ios_close];
+ios_set_hook += [poke_el_ios_set];
+
+fun poke_el_edit = (string name) void:
+{
+ var cmd = format (\"(poke-edit \\\"%s\\\")\", name);
+ plet_elval (cmd);
+}
+
+fun poke_el_pk_type_typekind = (Pk_Type pktype) string:
+{
+ return pktype.code == PK_TYPE_INTEGRAL ? \"integral\"
+ : pktype.code == PK_TYPE_STRUCT ? \"struct\"
+ : pktype.code == PK_TYPE_ARRAY ? \"array\"
+ : pktype.code == PK_TYPE_STRING ? \"string\"
+ : pktype.code == PK_TYPE_FUNCTION ? \"function\"
+ : pktype.code == PK_TYPE_OFFSET ? \"offset\"
+ : \"\";
+}
+
+fun poke_el_edit_1 = (string name, any val, Pk_Type valtype) void:
+{
+ var typekind = poke_el_pk_type_typekind (valtype);
+
+ var elem_names = \"'(\";
+ if (valtype.code in [PK_TYPE_ARRAY, PK_TYPE_STRUCT])
+ {
+ for (var i = 0UL; i < val'length; ++i)
+ elem_names += \"\\\"\" + val'ename (i) + \"\\\" \";
+ }
+ elem_names += \")\";
+
+ var cmd = format (\"(poke-edit-1 \\\"%s\\\" \\\"%s\\\" \\\"%s\\\" %s)\"
+ name, valtype.name, typekind, elem_names);
+ plet_elval (cmd);
+}
+
+fun poke_el_edit_2 = (string name, any val, Pk_Type valtype,
+ string[] elem_names, string[] elem_vals) void:
+{
+ fun escape_string = (string s) string:
+ {
+ var escaped = \"\";
+ /* XXX escape also backslashes. */
+ for (c in s)
+ if (c == '\"')
+ escaped += '\\\\' as string + '\"' as string;
+ else
+ escaped += c as string;
+ return escaped;
+ }
+
+ var typekind = poke_el_pk_type_typekind (valtype);
+
+ var elem_names_list = \"'(\";
+ for (var i = 0UL; i < elem_names'length; ++i)
+ elem_names_list += \"\\\"\" + elem_names[i] + \"\\\" \";
+ elem_names_list += \")\";
+
+ var elem_vals_list = \"'(\";
+ for (var i = 0UL; i < elem_vals'length; ++i)
+ elem_vals_list += \"\\\"\" + escape_string (elem_vals[i]) + \"\\\" \";
+ elem_vals_list += \")\";
+
+ var cmd = format (\"(poke-edit-2 \\\"%s\\\" \\\"%s\\\" \\\"%s\\\" %s %s)\"
+ name, valtype.name, typekind,
+ elem_names_list, elem_vals_list);
+ plet_elval (cmd);
+}
+
+fun poke_el_map = (string name) void:
+{
+ var cmd = format (\"(poke-maps-add-var \\\"%s\\\")\", name);
+ plet_elval (cmd);
+}
+
+fun poke_el_map_elems = (string name, any val, Pk_Type valtype) void:
+{
+ if (!val'mapped)
+ return;
+
+ for (var i = val'length - 1; i >= 0; --i)
+ poke_el_map (name
+ + ((val'ename (i))[0] == '[' ? \"\" : \".\")
+ + val'ename (i));
+}
+
+fun poke_el_map_1 = (string name, any val, Pk_Type valtype) void:
+{
+ if (!val'mapped)
+ return;
+
+ var cmd = format (\"(poke-maps-add \\\"%s\\\" \\\"%s\\\" %u64d)\"
+ name, valtype.name, val'offset/#b);
+ plet_elval (cmd);
+}
+
+fun quit = void:
+{
+ plet_elval (\"(poke-exit)\");
+}")
+
+(defun poke ()
+ (interactive)
+ (when (not (process-live-p poke-poked-process))
+ (setq poke-ios-alist nil)
+ (setq poke-maps-stack '(nil))
+ (poke-poked)
+ (sit-for 0.2))
+ (poke-elval)
+ (poke-code-send poke-pk)
+ (poke-init-settings)
+ (poke-repl)
+ (poke-vu)
+ (delete-other-windows)
+ (switch-to-buffer "*poke-repl*")
+ (let ((current-window (get-buffer-window)))
+ (switch-to-buffer-other-window "*poke-out*")
+ (switch-to-buffer-other-window "*poke-vu*")
+ (select-window current-window)))
+
+(defun poke-exit ()
+ (interactive)
+ ;; Note that killing the buffers will also kill the
+ ;; associated processes if they are running.
+ (mapcar
+ (lambda (bufname)
+ (let ((buf (get-buffer bufname)))
+ (when buf (kill-buffer buf))))
+ '("*poke-out*" "*poke-cmd*" "*poke-code*" "*poke-ios*"
+ "*poke-vu*" "*poke-repl*" "*poke-elval*" "*poked*"
+ "*poke-settings*" "*poke-maps*" "*poke-edit*" "*poke-complete*"))
+ (setq poke-repl-prompt poke-repl-default-prompt)
+ (setq poke-ios-alist nil))
+
+;;;; window layouts
+
+(defun poke-frame-layout-1 ()
+ (setq display-buffer-alist
+ (append
+ `(("\\*poke-vu\\*" display-buffer-in-side-window
+ (side . top) (slot . 0)
+ (preserve-size . (nil . t)))
+
("\\*\\(?:poke-edit\\|poke-code\\|poke-maps\\|poke-ios\\|poke-settings\\)\\*"
+ display-buffer-in-side-window
+ (side . right) (slot . 0) (window-width . fit-window-to-buffer)
+ (preserve-size . (t . nil)))
+ ("\\*poke-out\\*"
+ display-buffer-in-side-window
+ (side . bottom) (slot . -1) (preserve-size . (nil . t))))
+ display-buffer-alist)))
+
+(provide 'poke)
+;;; poke.el ends here
