[clfswm-cvs] r5 - clfswm
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sat Mar 1 12:49:59 UTC 2008
Author: pbrochard
Date: Sat Mar 1 07:49:46 2008
New Revision: 5
Added:
clfswm/AUTHORS
clfswm/COPYING
clfswm/ChangeLog
clfswm/README
clfswm/asdf.lisp
clfswm/bindings-second-mode.lisp
clfswm/bindings.lisp
clfswm/check-diff.sh (contents, props changed)
clfswm/clfswm-info.lisp
clfswm/clfswm-internal.lisp
clfswm/clfswm-keys.lisp
clfswm/clfswm-layout.lisp
clfswm/clfswm-pack.lisp
clfswm/clfswm-second-mode.lisp
clfswm/clfswm-util.lisp
clfswm/clfswm.asd
clfswm/clfswm.lisp
clfswm/clisp-load.lisp
clfswm/config.lisp
clfswm/dot-clfswmrc
clfswm/keys.html
clfswm/keys.txt
clfswm/keysyms.lisp
clfswm/load.lisp
clfswm/my-html.lisp
clfswm/netwm-util.lisp
clfswm/package.lisp
clfswm/program
clfswm/sbcl-load.lisp
clfswm/tools.lisp
clfswm/xlib-util.lisp
Log:
first commit
Added: clfswm/AUTHORS
==============================================================================
--- (empty file)
+++ clfswm/AUTHORS Sat Mar 1 07:49:46 2008
@@ -0,0 +1,14 @@
+CLFSWM - A(nother) Common Lisp FullScreen Window Manager
+---------------------------------------------------------
+
+Philippe Brochard hocwp at free dot fr
+
+
+-----------------------------------
+
+Some of the CLFSWM code is based on
+
+tinywm: http://incise.org/index.cgi/TinyWM
+
+And on the excellent Shawn Betts (sabetts at vcn bc ca)
+Stumpwm: http://www.nongnu.org/stumpwm/
Added: clfswm/COPYING
==============================================================================
--- (empty file)
+++ clfswm/COPYING Sat Mar 1 07:49:46 2008
@@ -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>.
Added: clfswm/ChangeLog
==============================================================================
--- (empty file)
+++ clfswm/ChangeLog Sat Mar 1 07:49:46 2008
@@ -0,0 +1,427 @@
+2008-02-27 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-layout.lisp (*-layout): Add an optional raise-p
+ parameter in each layout.
+
+2008-02-26 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (copy/cut-current-child): Does not affect the
+ root group.
+ (copy/move-current-child-by-name/number): new functions
+ (focus-group-by-name/number): new functions
+ (delete-group-by-name/number): new functions
+
+2008-02-24 Philippe Brochard <hocwp at free.fr>
+
+ * *: Major update - No more reference to workspaces. The main
+ structure is a tree of groups or application windows.
+
+2008-02-07 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (read-conf-file): Read configuration in
+ $HOME/.clfswmrc or in /etc/clfswmrc or in
+ $XDG_CONFIG_HOME/clfswm/clfswmrc.
+ (xdg-config-home): Return the content of $XDG-CONFIG-HOME (default
+ to $HOME/.config/).
+
+2008-01-18 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (show-all-group): Use *root* and *root-gc*
+ by default.
+
+2008-01-03 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (find-window-group): New function.
+
+ * clfswm*: Change to make clfswm run with clisp/new-clx.
+
+2008-01-01 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (query-show-paren): Add show parent matching in
+ query string.
+ (query-string): Bind control+k to delete end of line.
+
+ * clfswm-second-mode.lisp (draw-second-mode-window): Display
+ the action on mouse motion in second mode.
+
+ * clfswm.lisp (handle-exposure): Redisplay groups on exposure
+ event but do not clear the root window.
+ (handle-configure-request): Adjust unmanaged window from there
+ request.
+
+ * clfswm-internal.lisp (process-new-window): Adjust new window
+ with the specified hints (max/min/base width/height).
+
+2007-12-31 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (handle-configure-request): Send an Configuration
+ Notify event. This solve a bug with xterm and rxvt who takes some
+ times to be mapped. Now there is no delay.
+
+ * bindings-second-mode.lisp (define-shell): Run programs after
+ living the second mode.
+
+2007-12-30 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (process-new-window): Do not crop transient
+ window to group size.
+ (adapt-window-to-group): Do not crop transient window to group
+ size.
+
+ * clfswm.lisp (handle-configure-request): Adapt just the window to
+ its group and don't take care of the configure request. Remove the
+ bug with the Gimp outside the group and speed up the window
+ manipulation.
+ (handle-exposure): Remove show-all-group on exposure event
+ -> Speed up.
+
+2007-12-29 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (circulate-group-up-copy-window)
+ (circulate-group-down-copy-window)
+ (circulate-workspace-up-copy-group)
+ (circulate-workspace-down-copy-group): Prevent the copy of the
+ same window in the same workspace.
+
+ * bindings-second-mode.lisp (release-copy-selected-window)
+ (release-copy-selected-group): Prevent the copy of the same window
+ in the same workspace.
+
+ * clfswm-pager.lisp (generic-pager-move-window-on-previous-line)
+ (generic-pager-move-window-on-next-line): Remove the copy
+ property.
+ (generic-pager-move-group-on-next-workspace)
+ (generic-pager-move-group-on-previous-workspace): Prevent the copy
+ of the same window in the same workspace.
+
+ * bindings-pager.lisp (mouse-pager-copy-selected-window-release)
+ (mouse-pager-copy-selected-group-release): Prevent the copy of the
+ same window in the same workspace.
+
+ * tools.lisp (setf/=): new macro to set a variable only when
+ necessary.
+
+ * clfswm-internal.lisp (adapt-window-to-group): use set/= to set
+ x, y... only when necessary.
+
+2007-12-28 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (handle-configure-notify, *configure-notify-hook*):
+ new function and hook: force windows to stay in its group (solve a
+ bug with the Gimp).
+
+2007-12-25 Philippe Brochard <hocwp at free.fr>
+
+ * bindings-second-mode.lisp (mouse-motion): use hide-group to have
+ less flickering when moving/resizing groups.
+
+ * clfswm-internal.lisp (hide-group): new function.
+ (show-all-group): clear-all: new parameter.
+
+2007-12-22 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-keys.lisp (define-define-key): undefine-*-multi-name: new
+ macro.
+ * clfswm*: Color change for the pager. Typo or better description
+ in bindings definitions. Define bindings for a qwerty keyboard by
+ default. dot-clfswmrc show examples to switch to an azerty
+ keyboard.
+ License change to GPL v3.
+ * config.lisp: new file - group all globals variables in this
+ file.
+
+2007-08-26 Philippe Brochard <hocwp at free.fr>
+
+ * xlib-util.lisp (hide-window): Remove structure-notivy events
+ when hidding a window.
+
+2007-05-16 Philippe Brochard <hocwp at free.fr>
+
+ * package.lisp (*sm-property-notify-hook*): Readded
+ property-notify-hook in second mode.
+
+2007-05-15 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-keys.lisp (produce-doc-html): Better clean up for strings.
+
+2007-05-13 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pack.lisp (tile-current-workspace-to/right/left/top/bottom):
+ Tile the current workspace with the current window on one side and
+ others on the other (this emulate the larswm, dwm, wmii way). See
+ the default configuration file to enable this mode by default.
+
+ * clfswm-pager.lisp (pager-tile-current-workspace-to): idem for
+ the pager.
+
+2007-05-12 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-draw-window-in-group): Add
+ ensure-printable to print windows name even with non-ascii
+ characters.
+
+2007-05-11 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-explode-current-group): Create a new
+ group for each window in group.
+ (pager-implode-current-group): Move all windows in workspace to
+ one group and remove other groups.
+
+ * clfswm-pack.lisp (explode-group): Create a new group for each
+ window in group.
+ (implode-group): Move all windows in workspace to one group and
+ remove other groups.
+
+ * clfswm-util.lisp (identify-key): Remove local configuration
+ variables and made them available for configuration from
+ package.lisp.
+ (query-string): idem.
+
+2007-04-29 Philippe Brochard <hocwp at free.fr>
+
+ * netwm-util.lisp: Start of NetWM compliance.
+ Add a Netwm client list gestion.
+
+2007-04-28 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (create-group-on-request): open a new group
+ only when the current group is not empty.
+
+ * bindings-second-mode.lisp (define-second-key-#\o-control): Fix a
+ bug with null workspace.
+
+ * clfswm-pager.lisp (pager-handle-event): Add a hook
+ system. This hooks can be changed in the user configuration file.
+
+ * package.lisp: All colors and font variables are set in
+ package.lisp and can be configured in the user configuration
+ file.
+ Note: If you have configured some less ugly colors (esp. for the
+ pager) don't hesitate to let me know :)
+
+ * clfswm-second-mode.lisp (sm-handle-event): Add a hook
+ system. This hooks can be changed in the user configuration file.
+
+ * clfswm.lisp (handle-event): Add a hook system. This hooks can be
+ changed in the user configuration file (~/.clfswmrc)
+
+2007-04-25 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (stop-all-pending-actions): new function: reset
+ arrow action, open next window in new workspace/group.
+
+ * bindings.lisp (stop-all-pending-actions): new binding.
+ (open-next-window-in-new-group-once): Open the next windows in a
+ new group (only once) or open all new windows in a new group (like
+ others windows managers).
+
+2007-04-22 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (read-conf-file): New function to read a lisp
+ configuration file at startup.
+ (focus-group-under-mouse): Check if group isn't the current group
+ ( prevent a bug with unclutter ).
+
+2007-03-02 Philippe Brochard <hocwp at free.fr>
+
+ * bindings.lisp (run-program-from-query-string): A program can be
+ launch from a input query window.
+
+2007-03-01 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-info.lisp: Fix a bug with banish pointer in info mode.
+
+2007-02-28 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (process-new-window): One can now open the next
+ window in a workspace called by its number.
+
+ * clfswm-util.lisp (query-font-string): Minimal editing
+ capabilities.
+ (eval-from-string): And an REPL in the window manager... :)
+
+2007-02-26 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (process-new-window): One can now open the next
+ window in a new workspace or a new group.
+
+ * clfswm-pager.lisp (pager-mode): Display the next arrow action
+ with the hidden windows.
+
+ * clfswm.lisp (second-key-mode): Display the current workspace
+ number and the next arrow action in the state window.
+
+ * clfswm-pager.lisp (pager-mode): Hide all windows before leaving
+ the pager mode and then redisplay only the current workspace.
+
+2007-02-25 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (add-workspace): Workspaces are now numbered. So
+ they can be focused with a keypress, sorted or renumbered.
+
+2007-02-24 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-mode): Remove multiple silly
+ pager-draw-display. This prevent a lot of flickering in the
+ pager.
+
+ * clfswm.lisp: Remove all display-force-output and replace them
+ with only one display-finish-output in the event loop.
+
+2006-11-06 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-center-group): New function - center a
+ group at the middle of the screen.
+
+ * clfswm-pack.lisp (center-group): New function - center a group
+ at the middle of the screen.
+
+ * clfswm.lisp (show-group): Add a cross line under the group.
+ (show-group): Group are showned even if fullscreened.
+ (init-display): Add an exposure event on the root window.
+
+2006-11-05 Philippe Brochard <hocwp at free.fr>
+
+ * package.lisp (*default-group*): Default group is the same size
+ of a fullscreened group.
+
+ * bindings*: Use shift to move, control+shift to copy.
+
+ * *.lisp: Add comments for configuration or alternatives. So grep
+ for CONFIG to see where you can configure clfswm. And grep for
+ Alternative to use some commented code.
+
+ * clfswm.lisp (second-key-mode): Use a single window to show the
+ second mode. See for alternatives at the end of this file.
+
+2006-11-03 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-keys.lisp (define-define-key/mouse): Factorisation in a
+ macro of key and mouse definitions.
+ (define-define-key/mouse): Use state instead of modifiers list
+ this fix a bug when the modifiers list is not in the rigth order.
+
+ * clfswm.lisp (second-key-mode): Add a colored border in second mode.
+
+2006-11-02 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-info.lisp (info-mode): Add an info mode.
+
+2006-11-01 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (process-new-window): Change border size for
+ transient windows.
+ (show-all-windows-in-workspace): Unhide all windows even when the
+ current group is in fullscreen mode.
+
+2006-10-26 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (identify-key): Add an exposure handle-event to
+ redisplay the identify window after a terminal switch.
+
+ * clfswm-pager.lisp (pager-mode): Add an exposure handle-event to
+ redisplay the pager after a terminal switch.
+
+2006-10-24 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (identify-key): Add a window to display
+ the keys to identify on screen.
+
+ * bindings.lisp, bindings-pager.lisp: Define same keys to
+ move/copy groups/windows in second mode and in pager.
+
+ * clfswm.lisp (handle-event*): Same version in all clfswm (fix some
+ drawing lags).
+ (show-all-windows-in-workspace): unhide window before adapting it
+ to group.
+
+2006-10-23 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (handle-event): Revert to an older version.
+
+2006-10-18 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (force-window-in-group)
+ (force-window-center-in-group): New functions for transient windows.
+
+ * clfswm-pager.lisp (pager-remove-current-workspace/group):
+ bugfix: hide all windows before removing group or workspace.
+
+2006-10-17 Philippe Brochard <hocwp at free.fr>
+
+ * bindings-pager.lisp (mouse-pager-move-selected-group)
+ (mouse-pager-copy-selected-group)
+ (mouse-pager-move-selected-window)
+ (mouse-pager-copy-selected-window, mouse-pager-rotate-window-up)
+ (mouse-pager-rotate-window-down): New functions to have mouse in
+ pager mode.
+
+ * clfswm-pager.lisp (pager-swap-window)
+ (pager-copy-group-on-next/previous-workspace)
+ (pager-copy-window-on-next/previous-line): New functions
+
+2006-10-15 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-move-window-on-next/previous-line,
+ (pager-move-group-on-next/previous-workspace): new functions.
+
+ * clfswm-pack.lisp (resize-half-x-x-current-group): resize group
+ to its half size (new functions).
+
+2006-10-11 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp: workspaces, groups and windows can now be
+ selectionned with the keyboard or the mouse.
+
+2006-10-09 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-pager.lisp (pager-select-workspace-right/left):
+ workspaces can now be selectionned with the keyboard.
+
+2006-10-08 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-keys.lisp (undefine-main-key, undefine-second-key, undefine-mouse-action):
+ new function to remove a previous defined key or mouse combination.
+
+2006-10-07 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (main): Check for access error in init-display.
+
+ * clfswm-keys.lisp (define-ungrab/grab): check for keysym and
+ keycode before grabbing.
+
+ * bindings.lisp: Remove nlambda and use defun to keep the function
+ documentation with clisp.
+ (define-shell): new macro to define shell command for the second
+ mode.
+
+2006-10-06 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-keys.lisp (define-ungrab/grab): use a cond instead of a
+ boggus typecase.
+
+2006-10-05 Philippe Brochard <hocwp at free.fr>
+
+ * bindings.lisp (accept-motion): Move group bugfix in upper mouse
+ workspace circulation.
+
+ * clfswm-util.lisp (absorb-orphan-window): new function.
+
+ * clfswm-keys.lisp: Keysyms support.
+
+2006-10-02 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (show-group): Use one gc for all groups and not one
+ per group.
+
+2006-10-01 Philippe Brochard <hocwp at free.fr>
+
+ * bindings.lisp (define-second-key (#\l :mod-1)): fix a typo.
+
+ * clfswm.lisp (adapt-window-to-group): Adapt only windows with
+ width and height outside group.
+
+2006-09-28 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp: First public release.
+
Added: clfswm/README
==============================================================================
--- (empty file)
+++ clfswm/README Sat Mar 1 07:49:46 2008
@@ -0,0 +1,83 @@
+ CLFSWM - A(nother) Common Lisp FullScreen Window Manager
+
+ CLFSWM is a 100% Common Lisp X11 window manager (based on [1]Tinywm
+ and [2]Stumpwm. Many thanks to them).
+ It can be driven only with the keyboard or with the mouse.
+
+ A display is divided in workspaces, groups and windows. Windows are
+ packed together in groups.
+ By default a group is fullscreen maximized (no decorations, no buttons,
+ no menus: nothing, just the application fullscreen!).
+ When not maximized, a group of windows can be moved, resized, tiled,
+ packed or filled to others groups edges.
+
+ For its binding, CLFSWM has two modes.
+ A main mode with minimal keys and no mouse grabbing to avoid conflict
+ with others applications.
+ And a second mode with more keys and mouse actions.
+ For details of its usage, have a look at the files keys.txt or
+ keys.html
+
+
+* Installation
+
+Boot up a common lisp implementation. I develop it with sbcl, I've
+tested it with cmucl and I use it with clisp (you need the clx/xlib
+package).
+
+To use CLFSWM, load the load.lisp file. It loads the ASDF package,
+build the system and start the main loop.
+
+Another way is to do something like this:
+$ cd /in/the/directory/of/clfswm/
+$ clisp/cmucl/sbcl/... # start a lisp
+ > (load "asdf.lisp") ; asdf for clisp or cmucl
+or> (require :asdf) ; asdf for sbcl
+ > (require :clx) ; clx for cmucl
+ > (asdf:oos 'asdf:load-op :clfswm) ; compile and load the system
+ > (in-package :clfswm) ; go in the clfswm package
+ > (clfswm:main) ; start the main loop
+
+
+* Tweaking
+
+To change the default keybinding, have a look at the bindings*.lisp
+files and at the config.lisp file for global variables.
+
+All variables can be overwritten in a user configuration file
+(/etc/clfswmrc or $HOME/.clfswmrc). It's a standard lisp file loaded at
+startup. There is an example in the clfswm source (see dot-clfswmrc).
+
+If you want to add workspaces or groups at startup, tell this to
+clfswm in the init-display function in clfswm.lisp (there is already a
+default workspace and a default group created).
+
+In all cases, you can grep the source with 'CONFIG' and 'Alternative'
+keywords to find where you can simply customize clfswm.
+
+
+
+* Lisp implementation note
+
+If you are using clisp/new-clx, be sure to use the last version (at
+least 2.43). Older versions are a little bit bogus.
+If you are using clisp/mit-clx or an other clx than clisp/new-clx, you
+may find a speed up with the compress notify event. See the variable
+*have-to-compress-notify* in the configuration file.
+
+
+
+* License
+
+ CLFSWM is under the GNU General Public License - GPL license.
+ You can find more information in the files COPYING. or on the
+ [3]Free Software Foundation site.
+
+
+Philippe Brochard <hocwp at free dot fr>.
+
+Références
+
+ 1. http://incise.org/index.cgi/TinyWM
+ 2. http://www.nongnu.org/stumpwm/
+ 3. http://www.gnu.org/
Added: clfswm/asdf.lisp
==============================================================================
--- (empty file)
+++ clfswm/asdf.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,1102 @@
+;;; This is asdf: Another System Definition Facility. $Revision: 1.1 $
+;;;
+;;; Feedback, bug reports, and patches are all welcome: please mail to
+;;; <cclan-list at lists.sf.net>. But note first that the canonical
+;;; source for asdf is presently the cCLan CVS repository at
+;;; <URL:http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/>
+;;;
+;;; If you obtained this copy from anywhere else, and you experience
+;;; trouble using it, or find bugs, you may want to check at the
+;;; location above for a more recent version (and for documentation
+;;; and test files, if your copy came without them) before reporting
+;;; bugs. There are usually two "supported" revisions - the CVS HEAD
+;;; is the latest development version, whereas the revision tagged
+;;; RELEASE may be slightly older but is considered `stable'
+
+;;; Copyright (c) 2001-2003 Daniel Barlow and contributors
+;;;
+;;; Permission is hereby granted, free of charge, to any person obtaining
+;;; a copy of this software and associated documentation files (the
+;;; "Software"), to deal in the Software without restriction, including
+;;; without limitation the rights to use, copy, modify, merge, publish,
+;;; distribute, sublicense, and/or sell copies of the Software, and to
+;;; permit persons to whom the Software is furnished to do so, subject to
+;;; the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;;; the problem with writing a defsystem replacement is bootstrapping:
+;;; we can't use defsystem to compile it. Hence, all in one file
+
+(defpackage #:asdf
+ (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command
+ #:system-definition-pathname #:find-component ; miscellaneous
+ #:hyperdocumentation #:hyperdoc
+
+ #:compile-op #:load-op #:load-source-op #:test-system-version
+ #:test-op
+ #:operation ; operations
+ #:feature ; sort-of operation
+ #:version ; metaphorically sort-of an operation
+
+ #:input-files #:output-files #:perform ; operation methods
+ #:operation-done-p #:explain
+
+ #:component #:source-file
+ #:c-source-file #:cl-source-file #:java-source-file
+ #:static-file
+ #:doc-file
+ #:html-file
+ #:text-file
+ #:source-file-type
+ #:module ; components
+ #:system
+ #:unix-dso
+
+ #:module-components ; component accessors
+ #:component-pathname
+ #:component-relative-pathname
+ #:component-name
+ #:component-version
+ #:component-parent
+ #:component-property
+ #:component-system
+
+ #:component-depends-on
+
+ #:system-description
+ #:system-long-description
+ #:system-author
+ #:system-maintainer
+ #:system-license
+
+ #:operation-on-warnings
+ #:operation-on-failure
+
+ ;#:*component-parent-pathname*
+ #:*system-definition-search-functions*
+ #:*central-registry* ; variables
+ #:*compile-file-warnings-behaviour*
+ #:*compile-file-failure-behaviour*
+ #:*asdf-revision*
+
+ #:operation-error #:compile-failed #:compile-warned #:compile-error
+ #:error-component #:error-operation
+ #:system-definition-error
+ #:missing-component
+ #:missing-dependency
+ #:circular-dependency ; errors
+
+ #:retry
+ #:accept ; restarts
+
+ )
+ (:use :cl))
+
+#+nil
+(error "The author of this file habitually uses #+nil to comment out forms. But don't worry, it was unlikely to work in the New Implementation of Lisp anyway")
+
+
+(in-package #:asdf)
+
+(defvar *asdf-revision* (let* ((v "$Revision: 1.1 $")
+ (colon (or (position #\: v) -1))
+ (dot (position #\. v)))
+ (and v colon dot
+ (list (parse-integer v :start (1+ colon)
+ :junk-allowed t)
+ (parse-integer v :start (1+ dot)
+ :junk-allowed t)))))
+
+(defvar *compile-file-warnings-behaviour* :warn)
+(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
+
+(defvar *verbose-out* nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; utility stuff
+
+(defmacro aif (test then &optional else)
+ `(let ((it ,test)) (if it ,then ,else)))
+
+(defun pathname-sans-name+type (pathname)
+ "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
+and NIL NAME and TYPE components"
+ (make-pathname :name nil :type nil :defaults pathname))
+
+(define-modify-macro appendf (&rest args)
+ append "Append onto list")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; classes, condiitons
+
+(define-condition system-definition-error (error) ()
+ ;; [this use of :report should be redundant, but unfortunately it's not.
+ ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function
+ ;; over print-object; this is always conditions::%print-condition for
+ ;; condition objects, which in turn does inheritance of :report options at
+ ;; run-time. fortunately, inheritance means we only need this kludge here in
+ ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.]
+ #+cmu (:report print-object))
+
+(define-condition formatted-system-definition-error (system-definition-error)
+ ((format-control :initarg :format-control :reader format-control)
+ (format-arguments :initarg :format-arguments :reader format-arguments))
+ (:report (lambda (c s)
+ (apply #'format s (format-control c) (format-arguments c)))))
+
+(define-condition circular-dependency (system-definition-error)
+ ((components :initarg :components :reader circular-dependency-components)))
+
+(define-condition missing-component (system-definition-error)
+ ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
+ (version :initform nil :reader missing-version :initarg :version)
+ (parent :initform nil :reader missing-parent :initarg :parent)))
+
+(define-condition missing-dependency (missing-component)
+ ((required-by :initarg :required-by :reader missing-required-by)))
+
+(define-condition operation-error (error)
+ ((component :reader error-component :initarg :component)
+ (operation :reader error-operation :initarg :operation))
+ (:report (lambda (c s)
+ (format s "~@<erred while invoking ~A on ~A~@:>"
+ (error-operation c) (error-component c)))))
+(define-condition compile-error (operation-error) ())
+(define-condition compile-failed (compile-error) ())
+(define-condition compile-warned (compile-error) ())
+
+(defclass component ()
+ ((name :accessor component-name :initarg :name :documentation
+ "Component name: designator for a string composed of portable pathname characters")
+ (version :accessor component-version :initarg :version)
+ (in-order-to :initform nil :initarg :in-order-to)
+ ;;; XXX crap name
+ (do-first :initform nil :initarg :do-first)
+ ;; methods defined using the "inline" style inside a defsystem form:
+ ;; need to store them somewhere so we can delete them when the system
+ ;; is re-evaluated
+ (inline-methods :accessor component-inline-methods :initform nil)
+ (parent :initarg :parent :initform nil :reader component-parent)
+ ;; no direct accessor for pathname, we do this as a method to allow
+ ;; it to default in funky ways if not supplied
+ (relative-pathname :initarg :pathname)
+ (operation-times :initform (make-hash-table )
+ :accessor component-operation-times)
+ ;; XXX we should provide some atomic interface for updating the
+ ;; component properties
+ (properties :accessor component-properties :initarg :properties
+ :initform nil)))
+
+;;;; methods: conditions
+
+(defmethod print-object ((c missing-dependency) s)
+ (format s "~@<~A, required by ~A~@:>"
+ (call-next-method c nil) (missing-required-by c)))
+
+(defun sysdef-error (format &rest arguments)
+ (error 'formatted-system-definition-error :format-control format :format-arguments arguments))
+
+;;;; methods: components
+
+(defmethod print-object ((c missing-component) s)
+ (format s "~@<component ~S not found~
+ ~@[ or does not match version ~A~]~
+ ~@[ in ~A~]~@:>"
+ (missing-requires c)
+ (missing-version c)
+ (when (missing-parent c)
+ (component-name (missing-parent c)))))
+
+(defgeneric component-system (component)
+ (:documentation "Find the top-level system containing COMPONENT"))
+
+(defmethod component-system ((component component))
+ (aif (component-parent component)
+ (component-system it)
+ component))
+
+(defmethod print-object ((c component) stream)
+ (print-unreadable-object (c stream :type t :identity t)
+ (ignore-errors
+ (prin1 (component-name c) stream))))
+
+(defclass module (component)
+ ((components :initform nil :accessor module-components :initarg :components)
+ ;; what to do if we can't satisfy a dependency of one of this module's
+ ;; components. This allows a limited form of conditional processing
+ (if-component-dep-fails :initform :fail
+ :accessor module-if-component-dep-fails
+ :initarg :if-component-dep-fails)
+ (default-component-class :accessor module-default-component-class
+ :initform 'cl-source-file :initarg :default-component-class)))
+
+(defgeneric component-pathname (component)
+ (:documentation "Extracts the pathname applicable for a particular component."))
+
+(defun component-parent-pathname (component)
+ (aif (component-parent component)
+ (component-pathname it)
+ *default-pathname-defaults*))
+
+(defgeneric component-relative-pathname (component)
+ (:documentation "Extracts the relative pathname applicable for a particular component."))
+
+(defmethod component-relative-pathname ((component module))
+ (or (slot-value component 'relative-pathname)
+ (make-pathname
+ :directory `(:relative ,(component-name component))
+ :host (pathname-host (component-parent-pathname component)))))
+
+(defmethod component-pathname ((component component))
+ (let ((*default-pathname-defaults* (component-parent-pathname component)))
+ (merge-pathnames (component-relative-pathname component))))
+
+(defgeneric component-property (component property))
+
+(defmethod component-property ((c component) property)
+ (cdr (assoc property (slot-value c 'properties) :test #'equal)))
+
+(defgeneric (setf component-property) (new-value component property))
+
+(defmethod (setf component-property) (new-value (c component) property)
+ (let ((a (assoc property (slot-value c 'properties) :test #'equal)))
+ (if a
+ (setf (cdr a) new-value)
+ (setf (slot-value c 'properties)
+ (acons property new-value (slot-value c 'properties))))))
+
+(defclass system (module)
+ ((description :accessor system-description :initarg :description)
+ (long-description
+ :accessor system-long-description :initarg :long-description)
+ (author :accessor system-author :initarg :author)
+ (maintainer :accessor system-maintainer :initarg :maintainer)
+ (licence :accessor system-licence :initarg :licence)))
+
+;;; version-satisfies
+
+;;; with apologies to christophe rhodes ...
+(defun split (string &optional max (ws '(#\Space #\Tab)))
+ (flet ((is-ws (char) (find char ws)))
+ (nreverse
+ (let ((list nil) (start 0) (words 0) end)
+ (loop
+ (when (and max (>= words (1- max)))
+ (return (cons (subseq string start) list)))
+ (setf end (position-if #'is-ws string :start start))
+ (push (subseq string start end) list)
+ (incf words)
+ (unless end (return list))
+ (setf start (1+ end)))))))
+
+(defgeneric version-satisfies (component version))
+
+(defmethod version-satisfies ((c component) version)
+ (unless (and version (slot-boundp c 'version))
+ (return-from version-satisfies t))
+ (let ((x (mapcar #'parse-integer
+ (split (component-version c) nil '(#\.))))
+ (y (mapcar #'parse-integer
+ (split version nil '(#\.)))))
+ (labels ((bigger (x y)
+ (cond ((not y) t)
+ ((not x) nil)
+ ((> (car x) (car y)) t)
+ ((= (car x) (car y))
+ (bigger (cdr x) (cdr y))))))
+ (and (= (car x) (car y))
+ (or (not (cdr y)) (bigger (cdr x) (cdr y)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finding systems
+
+(defvar *defined-systems* (make-hash-table :test 'equal))
+(defun coerce-name (name)
+ (typecase name
+ (component (component-name name))
+ (symbol (string-downcase (symbol-name name)))
+ (string name)
+ (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
+
+;;; for the sake of keeping things reasonably neat, we adopt a
+;;; convention that functions in this list are prefixed SYSDEF-
+
+(defvar *system-definition-search-functions*
+ '(sysdef-central-registry-search))
+
+(defun system-definition-pathname (system)
+ (some (lambda (x) (funcall x system))
+ *system-definition-search-functions*))
+
+(defvar *central-registry*
+ '(*default-pathname-defaults*
+ #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
+ #+nil "telent:asdf;systems;"))
+
+(defun sysdef-central-registry-search (system)
+ (let ((name (coerce-name system)))
+ (block nil
+ (dolist (dir *central-registry*)
+ (let* ((defaults (eval dir))
+ (file (and defaults
+ (make-pathname
+ :defaults defaults :version :newest
+ :name name :type "asd" :case :local))))
+ (if (and file (probe-file file))
+ (return file)))))))
+
+
+(defun find-system (name &optional (error-p t))
+ (let* ((name (coerce-name name))
+ (in-memory (gethash name *defined-systems*))
+ (on-disk (system-definition-pathname name)))
+ (when (and on-disk
+ (or (not in-memory)
+ (< (car in-memory) (file-write-date on-disk))))
+ (let ((*package* (make-package (gensym #.(package-name *package*))
+ :use '(:cl :asdf))))
+ (format *verbose-out*
+ "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
+ ;; FIXME: This wants to be (ENOUGH-NAMESTRING
+ ;; ON-DISK), but CMUCL barfs on that.
+ on-disk
+ *package*)
+ (load on-disk)))
+ (let ((in-memory (gethash name *defined-systems*)))
+ (if in-memory
+ (progn (if on-disk (setf (car in-memory) (file-write-date on-disk)))
+ (cdr in-memory))
+ (if error-p (error 'missing-component :requires name))))))
+
+(defun register-system (name system)
+ (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
+ (setf (gethash (coerce-name name) *defined-systems*)
+ (cons (get-universal-time) system)))
+
+(defun system-registered-p (name)
+ (gethash (coerce-name name) *defined-systems*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finding components
+
+(defgeneric find-component (module name &optional version)
+ (:documentation "Finds the component with name NAME present in the
+MODULE module; if MODULE is nil, then the component is assumed to be a
+system."))
+
+(defmethod find-component ((module module) name &optional version)
+ (if (slot-boundp module 'components)
+ (let ((m (find name (module-components module)
+ :test #'equal :key #'component-name)))
+ (if (and m (version-satisfies m version)) m))))
+
+
+;;; a component with no parent is a system
+(defmethod find-component ((module (eql nil)) name &optional version)
+ (let ((m (find-system name nil)))
+ (if (and m (version-satisfies m version)) m)))
+
+;;; component subclasses
+
+(defclass source-file (component) ())
+
+(defclass cl-source-file (source-file) ())
+(defclass c-source-file (source-file) ())
+(defclass java-source-file (source-file) ())
+(defclass static-file (source-file) ())
+(defclass doc-file (static-file) ())
+(defclass html-file (doc-file) ())
+
+(defgeneric source-file-type (component system))
+(defmethod source-file-type ((c cl-source-file) (s module)) "lisp")
+(defmethod source-file-type ((c c-source-file) (s module)) "c")
+(defmethod source-file-type ((c java-source-file) (s module)) "java")
+(defmethod source-file-type ((c html-file) (s module)) "html")
+(defmethod source-file-type ((c static-file) (s module)) nil)
+
+(defmethod component-relative-pathname ((component source-file))
+ (let* ((*default-pathname-defaults* (component-parent-pathname component))
+ (name-type
+ (make-pathname
+ :name (component-name component)
+ :type (source-file-type component
+ (component-system component)))))
+ (if (slot-value component 'relative-pathname)
+ (merge-pathnames
+ (slot-value component 'relative-pathname)
+ name-type)
+ name-type)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; operations
+
+;;; one of these is instantiated whenever (operate ) is called
+
+(defclass operation ()
+ ((forced :initform nil :initarg :force :accessor operation-forced)
+ (original-initargs :initform nil :initarg :original-initargs
+ :accessor operation-original-initargs)
+ (visited-nodes :initform nil :accessor operation-visited-nodes)
+ (visiting-nodes :initform nil :accessor operation-visiting-nodes)
+ (parent :initform nil :initarg :parent :accessor operation-parent)))
+
+(defmethod print-object ((o operation) stream)
+ (print-unreadable-object (o stream :type t :identity t)
+ (ignore-errors
+ (prin1 (operation-original-initargs o) stream))))
+
+(defmethod shared-initialize :after ((operation operation) slot-names
+ &key force
+ &allow-other-keys)
+ (declare (ignore slot-names force))
+ ;; empty method to disable initarg validity checking
+ )
+
+(defgeneric perform (operation component))
+(defgeneric operation-done-p (operation component))
+(defgeneric explain (operation component))
+(defgeneric output-files (operation component))
+(defgeneric input-files (operation component))
+
+(defun node-for (o c)
+ (cons (class-name (class-of o)) c))
+
+(defgeneric operation-ancestor (operation)
+ (:documentation "Recursively chase the operation's parent pointer until we get to the head of the tree"))
+
+(defmethod operation-ancestor ((operation operation))
+ (aif (operation-parent operation)
+ (operation-ancestor it)
+ operation))
+
+
+(defun make-sub-operation (c o dep-c dep-o)
+ (let* ((args (copy-list (operation-original-initargs o)))
+ (force-p (getf args :force)))
+ ;; note explicit comparison with T: any other non-NIL force value
+ ;; (e.g. :recursive) will pass through
+ (cond ((and (null (component-parent c))
+ (null (component-parent dep-c))
+ (not (eql c dep-c)))
+ (when (eql force-p t)
+ (setf (getf args :force) nil))
+ (apply #'make-instance dep-o
+ :parent o
+ :original-initargs args args))
+ ((subtypep (type-of o) dep-o)
+ o)
+ (t
+ (apply #'make-instance dep-o
+ :parent o :original-initargs args args)))))
+
+
+(defgeneric visit-component (operation component data))
+
+(defmethod visit-component ((o operation) (c component) data)
+ (unless (component-visited-p o c)
+ (push (cons (node-for o c) data)
+ (operation-visited-nodes (operation-ancestor o)))))
+
+(defgeneric component-visited-p (operation component))
+
+(defmethod component-visited-p ((o operation) (c component))
+ (assoc (node-for o c)
+ (operation-visited-nodes (operation-ancestor o))
+ :test 'equal))
+
+(defgeneric (setf visiting-component) (new-value operation component))
+
+(defmethod (setf visiting-component) (new-value operation component)
+ ;; MCL complains about unused lexical variables
+ (declare (ignorable new-value operation component)))
+
+(defmethod (setf visiting-component) (new-value (o operation) (c component))
+ (let ((node (node-for o c))
+ (a (operation-ancestor o)))
+ (if new-value
+ (pushnew node (operation-visiting-nodes a) :test 'equal)
+ (setf (operation-visiting-nodes a)
+ (remove node (operation-visiting-nodes a) :test 'equal)))))
+
+(defgeneric component-visiting-p (operation component))
+
+(defmethod component-visiting-p ((o operation) (c component))
+ (let ((node (cons o c)))
+ (member node (operation-visiting-nodes (operation-ancestor o))
+ :test 'equal)))
+
+(defgeneric component-depends-on (operation component))
+
+(defmethod component-depends-on ((o operation) (c component))
+ (cdr (assoc (class-name (class-of o))
+ (slot-value c 'in-order-to))))
+
+(defgeneric component-self-dependencies (operation component))
+
+(defmethod component-self-dependencies ((o operation) (c component))
+ (let ((all-deps (component-depends-on o c)))
+ (remove-if-not (lambda (x)
+ (member (component-name c) (cdr x) :test #'string=))
+ all-deps)))
+
+(defmethod input-files ((operation operation) (c component))
+ (let ((parent (component-parent c))
+ (self-deps (component-self-dependencies operation c)))
+ (if self-deps
+ (mapcan (lambda (dep)
+ (destructuring-bind (op name) dep
+ (output-files (make-instance op)
+ (find-component parent name))))
+ self-deps)
+ ;; no previous operations needed? I guess we work with the
+ ;; original source file, then
+ (list (component-pathname c)))))
+
+(defmethod input-files ((operation operation) (c module)) nil)
+
+(defmethod operation-done-p ((o operation) (c component))
+ (let ((out-files (output-files o c))
+ (in-files (input-files o c)))
+ (cond ((and (not in-files) (not out-files))
+ ;; arbitrary decision: an operation that uses nothing to
+ ;; produce nothing probably isn't doing much
+ t)
+ ((not out-files)
+ (let ((op-done
+ (gethash (type-of o)
+ (component-operation-times c))))
+ (and op-done
+ (>= op-done
+ (or (apply #'max
+ (mapcar #'file-write-date in-files)) 0)))))
+ ((not in-files) nil)
+ (t
+ (and
+ (every #'probe-file out-files)
+ (> (apply #'min (mapcar #'file-write-date out-files))
+ (apply #'max (mapcar #'file-write-date in-files)) ))))))
+
+;;; So you look at this code and think "why isn't it a bunch of
+;;; methods". And the answer is, because standard method combination
+;;; runs :before methods most->least-specific, which is back to front
+;;; for our purposes. And CLISP doesn't have non-standard method
+;;; combinations, so let's keep it simple and aspire to portability
+
+(defgeneric traverse (operation component))
+(defmethod traverse ((operation operation) (c component))
+ (let ((forced nil))
+ (labels ((do-one-dep (required-op required-c required-v)
+ (let* ((dep-c (or (find-component
+ (component-parent c)
+ ;; XXX tacky. really we should build the
+ ;; in-order-to slot with canonicalized
+ ;; names instead of coercing this late
+ (coerce-name required-c) required-v)
+ (error 'missing-dependency :required-by c
+ :version required-v
+ :requires required-c)))
+ (op (make-sub-operation c operation dep-c required-op)))
+ (traverse op dep-c)))
+ (do-dep (op dep)
+ (cond ((eq op 'feature)
+ (or (member (car dep) *features*)
+ (error 'missing-dependency :required-by c
+ :requires (car dep) :version nil)))
+ (t
+ (dolist (d dep)
+ (cond ((consp d)
+ (assert (string-equal
+ (symbol-name (first d))
+ "VERSION"))
+ (appendf forced
+ (do-one-dep op (second d) (third d))))
+ (t
+ (appendf forced (do-one-dep op d nil)))))))))
+ (aif (component-visited-p operation c)
+ (return-from traverse
+ (if (cdr it) (list (cons 'pruned-op c)) nil)))
+ ;; dependencies
+ (if (component-visiting-p operation c)
+ (error 'circular-dependency :components (list c)))
+ (setf (visiting-component operation c) t)
+ (loop for (required-op . deps) in (component-depends-on operation c)
+ do (do-dep required-op deps))
+ ;; constituent bits
+ (let ((module-ops
+ (when (typep c 'module)
+ (let ((at-least-one nil)
+ (forced nil)
+ (error nil))
+ (loop for kid in (module-components c)
+ do (handler-case
+ (appendf forced (traverse operation kid ))
+ (missing-dependency (condition)
+ (if (eq (module-if-component-dep-fails c) :fail)
+ (error condition))
+ (setf error condition))
+ (:no-error (c)
+ (declare (ignore c))
+ (setf at-least-one t))))
+ (when (and (eq (module-if-component-dep-fails c) :try-next)
+ (not at-least-one))
+ (error error))
+ forced))))
+ ;; now the thing itself
+ (when (or forced module-ops
+ (not (operation-done-p operation c))
+ (let ((f (operation-forced (operation-ancestor operation))))
+ (and f (or (not (consp f))
+ (member (component-name
+ (operation-ancestor operation))
+ (mapcar #'coerce-name f)
+ :test #'string=)))))
+ (let ((do-first (cdr (assoc (class-name (class-of operation))
+ (slot-value c 'do-first)))))
+ (loop for (required-op . deps) in do-first
+ do (do-dep required-op deps)))
+ (setf forced (append (delete 'pruned-op forced :key #'car)
+ (delete 'pruned-op module-ops :key #'car)
+ (list (cons operation c))))))
+ (setf (visiting-component operation c) nil)
+ (visit-component operation c (and forced t))
+ forced)))
+
+
+(defmethod perform ((operation operation) (c source-file))
+ (sysdef-error
+ "~@<required method PERFORM not implemented ~
+ for operation ~A, component ~A~@:>"
+ (class-of operation) (class-of c)))
+
+(defmethod perform ((operation operation) (c module))
+ nil)
+
+(defmethod explain ((operation operation) (component component))
+ (format *verbose-out* "~&;;; ~A on ~A~%" operation component))
+
+;;; compile-op
+
+(defclass compile-op (operation)
+ ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil)
+ (on-warnings :initarg :on-warnings :accessor operation-on-warnings
+ :initform *compile-file-warnings-behaviour*)
+ (on-failure :initarg :on-failure :accessor operation-on-failure
+ :initform *compile-file-failure-behaviour*)))
+
+(defmethod perform :before ((operation compile-op) (c source-file))
+ (map nil #'ensure-directories-exist (output-files operation c)))
+
+(defmethod perform :after ((operation operation) (c component))
+ (setf (gethash (type-of operation) (component-operation-times c))
+ (get-universal-time)))
+
+;;; perform is required to check output-files to find out where to put
+;;; its answers, in case it has been overridden for site policy
+(defmethod perform ((operation compile-op) (c cl-source-file))
+ #-:broken-fasl-loader
+ (let ((source-file (component-pathname c))
+ (output-file (car (output-files operation c))))
+ (multiple-value-bind (output warnings-p failure-p)
+ (compile-file source-file
+ :output-file output-file)
+ ;(declare (ignore output))
+ (when warnings-p
+ (case (operation-on-warnings operation)
+ (:warn (warn
+ "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>"
+ operation c))
+ (:error (error 'compile-warned :component c :operation operation))
+ (:ignore nil)))
+ (when failure-p
+ (case (operation-on-failure operation)
+ (:warn (warn
+ "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>"
+ operation c))
+ (:error (error 'compile-failed :component c :operation operation))
+ (:ignore nil)))
+ (unless output
+ (error 'compile-error :component c :operation operation)))))
+
+(defmethod output-files ((operation compile-op) (c cl-source-file))
+ #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c)))
+ #+:broken-fasl-loader (list (component-pathname c)))
+
+(defmethod perform ((operation compile-op) (c static-file))
+ nil)
+
+(defmethod output-files ((operation compile-op) (c static-file))
+ nil)
+
+;;; load-op
+
+(defclass load-op (operation) ())
+
+(defmethod perform ((o load-op) (c cl-source-file))
+ (mapcar #'load (input-files o c)))
+
+(defmethod perform ((operation load-op) (c static-file))
+ nil)
+(defmethod operation-done-p ((operation load-op) (c static-file))
+ t)
+
+(defmethod output-files ((o operation) (c component))
+ nil)
+
+(defmethod component-depends-on ((operation load-op) (c component))
+ (cons (list 'compile-op (component-name c))
+ (call-next-method)))
+
+;;; load-source-op
+
+(defclass load-source-op (operation) ())
+
+(defmethod perform ((o load-source-op) (c cl-source-file))
+ (let ((source (component-pathname c)))
+ (setf (component-property c 'last-loaded-as-source)
+ (and (load source)
+ (get-universal-time)))))
+
+(defmethod perform ((operation load-source-op) (c static-file))
+ nil)
+
+(defmethod output-files ((operation load-source-op) (c component))
+ nil)
+
+;;; FIXME: we simply copy load-op's dependencies. this is Just Not Right.
+(defmethod component-depends-on ((o load-source-op) (c component))
+ (let ((what-would-load-op-do (cdr (assoc 'load-op
+ (slot-value c 'in-order-to)))))
+ (mapcar (lambda (dep)
+ (if (eq (car dep) 'load-op)
+ (cons 'load-source-op (cdr dep))
+ dep))
+ what-would-load-op-do)))
+
+(defmethod operation-done-p ((o load-source-op) (c source-file))
+ (if (or (not (component-property c 'last-loaded-as-source))
+ (> (file-write-date (component-pathname c))
+ (component-property c 'last-loaded-as-source)))
+ nil t))
+
+(defclass test-op (operation) ())
+
+(defmethod perform ((operation test-op) (c component))
+ nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; invoking operations
+
+(defun operate (operation-class system &rest args)
+ (let* ((op (apply #'make-instance operation-class
+ :original-initargs args args))
+ (*verbose-out*
+ (if (getf args :verbose t)
+ *trace-output*
+ (make-broadcast-stream)))
+ (system (if (typep system 'component) system (find-system system)))
+ (steps (traverse op system)))
+ (with-compilation-unit ()
+ (loop for (op . component) in steps do
+ (loop
+ (restart-case
+ (progn (perform op component)
+ (return))
+ (retry ()
+ :report
+ (lambda (s)
+ (format s "~@<Retry performing ~S on ~S.~@:>"
+ op component)))
+ (accept ()
+ :report
+ (lambda (s)
+ (format s
+ "~@<Continue, treating ~S on ~S as ~
+ having been successful.~@:>"
+ op component))
+ (setf (gethash (type-of op)
+ (component-operation-times component))
+ (get-universal-time))
+ (return))))))))
+
+(defun oos (&rest args)
+ "Alias of OPERATE function"
+ (apply #'operate args))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; syntax
+
+(defun remove-keyword (key arglist)
+ (labels ((aux (key arglist)
+ (cond ((null arglist) nil)
+ ((eq key (car arglist)) (cddr arglist))
+ (t (cons (car arglist) (cons (cadr arglist)
+ (remove-keyword
+ key (cddr arglist))))))))
+ (aux key arglist)))
+
+(defmacro defsystem (name &body options)
+ (destructuring-bind (&key pathname (class 'system) &allow-other-keys) options
+ (let ((component-options (remove-keyword :class options)))
+ `(progn
+ ;; system must be registered before we parse the body, otherwise
+ ;; we recur when trying to find an existing system of the same name
+ ;; to reuse options (e.g. pathname) from
+ (let ((s (system-registered-p ',name)))
+ (cond ((and s (eq (type-of (cdr s)) ',class))
+ (setf (car s) (get-universal-time)))
+ (s
+ #+clisp
+ (sysdef-error "Cannot redefine the existing system ~A with a different class" s)
+ #-clisp
+ (change-class (cdr s) ',class))
+ (t
+ (register-system (quote ,name)
+ (make-instance ',class :name ',name)))))
+ (parse-component-form nil (apply
+ #'list
+ :module (coerce-name ',name)
+ :pathname
+ (or ,pathname
+ (pathname-sans-name+type
+ (resolve-symlinks *load-truename*))
+ *default-pathname-defaults*)
+ ',component-options))))))
+
+
+(defun class-for-type (parent type)
+ (let ((class
+ (find-class
+ (or (find-symbol (symbol-name type) *package*)
+ (find-symbol (symbol-name type) #.(package-name *package*)))
+ nil)))
+ (or class
+ (and (eq type :file)
+ (or (module-default-component-class parent)
+ (find-class 'cl-source-file)))
+ (sysdef-error "~@<don't recognize component type ~A~@:>" type))))
+
+(defun maybe-add-tree (tree op1 op2 c)
+ "Add the node C at /OP1/OP2 in TREE, unless it's there already.
+Returns the new tree (which probably shares structure with the old one)"
+ (let ((first-op-tree (assoc op1 tree)))
+ (if first-op-tree
+ (progn
+ (aif (assoc op2 (cdr first-op-tree))
+ (if (find c (cdr it))
+ nil
+ (setf (cdr it) (cons c (cdr it))))
+ (setf (cdr first-op-tree)
+ (acons op2 (list c) (cdr first-op-tree))))
+ tree)
+ (acons op1 (list (list op2 c)) tree))))
+
+(defun union-of-dependencies (&rest deps)
+ (let ((new-tree nil))
+ (dolist (dep deps)
+ (dolist (op-tree dep)
+ (dolist (op (cdr op-tree))
+ (dolist (c (cdr op))
+ (setf new-tree
+ (maybe-add-tree new-tree (car op-tree) (car op) c))))))
+ new-tree))
+
+
+(defun remove-keys (key-names args)
+ (loop for ( name val ) on args by #'cddr
+ unless (member (symbol-name name) key-names
+ :key #'symbol-name :test 'equal)
+ append (list name val)))
+
+(defvar *serial-depends-on*)
+
+(defun parse-component-form (parent options)
+ (destructuring-bind
+ (type name &rest rest &key
+ ;; the following list of keywords is reproduced below in the
+ ;; remove-keys form. important to keep them in sync
+ components pathname default-component-class
+ perform explain output-files operation-done-p
+ depends-on serial in-order-to
+ ;; list ends
+ &allow-other-keys) options
+ (check-component-input type name depends-on components in-order-to)
+ (let* ((other-args (remove-keys
+ '(components pathname default-component-class
+ perform explain output-files operation-done-p
+ depends-on serial in-order-to)
+ rest))
+ (ret
+ (or (find-component parent name)
+ (make-instance (class-for-type parent type)))))
+ (when (boundp '*serial-depends-on*)
+ (setf depends-on
+ (concatenate 'list *serial-depends-on* depends-on)))
+ (apply #'reinitialize-instance
+ ret
+ :name (coerce-name name)
+ :pathname pathname
+ :parent parent
+ other-args)
+ (when (typep ret 'module)
+ (setf (module-default-component-class ret)
+ (or default-component-class
+ (and (typep parent 'module)
+ (module-default-component-class parent))))
+ (let ((*serial-depends-on* nil))
+ (setf (module-components ret)
+ (loop for c-form in components
+ for c = (parse-component-form ret c-form)
+ collect c
+ if serial
+ do (push (component-name c) *serial-depends-on*)))))
+
+ (setf (slot-value ret 'in-order-to)
+ (union-of-dependencies
+ in-order-to
+ `((compile-op (compile-op , at depends-on))
+ (load-op (load-op , at depends-on))))
+ (slot-value ret 'do-first) `((compile-op (load-op , at depends-on))))
+
+ (loop for (n v) in `((perform ,perform) (explain ,explain)
+ (output-files ,output-files)
+ (operation-done-p ,operation-done-p))
+ do (map 'nil
+ ;; this is inefficient as most of the stored
+ ;; methods will not be for this particular gf n
+ ;; But this is hardly performance-critical
+ (lambda (m) (remove-method (symbol-function n) m))
+ (component-inline-methods ret))
+ when v
+ do (destructuring-bind (op qual (o c) &body body) v
+ (pushnew
+ (eval `(defmethod ,n ,qual ((,o ,op) (,c (eql ,ret)))
+ , at body))
+ (component-inline-methods ret))))
+ ret)))
+
+(defun check-component-input (type name depends-on components in-order-to)
+ "A partial test of the values of a component."
+ (unless (listp depends-on)
+ (sysdef-error-component ":depends-on must be a list."
+ type name depends-on))
+ (unless (listp components)
+ (sysdef-error-component ":components must be NIL or a list of components."
+ type name components))
+ (unless (and (listp in-order-to) (listp (car in-order-to)))
+ (sysdef-error-component ":in-order-to must be NIL or a list of components."
+ type name in-order-to)))
+
+(defun sysdef-error-component (msg type name value)
+ (sysdef-error (concatenate 'string msg
+ "~&The value specified for ~(~A~) ~A is ~W")
+ type name value))
+
+(defun resolve-symlinks (path)
+ #-allegro (truename path)
+ #+allegro (excl:pathname-resolve-symbolic-links path)
+ )
+
+;;; optional extras
+
+;;; run-shell-command functions for other lisp implementations will be
+;;; gratefully accepted, if they do the same thing. If the docstring
+;;; is ambiguous, send a bug report
+
+(defun run-shell-command (control-string &rest args)
+ "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
+synchronously execute the result using a Bourne-compatible shell, with
+output to *verbose-out*. Returns the shell's exit code."
+ (let ((command (apply #'format nil control-string args)))
+ (format *verbose-out* "; $ ~A~%" command)
+ #+sbcl
+ (sb-impl::process-exit-code
+ (sb-ext:run-program
+ "/bin/sh"
+ (list "-c" command)
+ :input nil :output *verbose-out*))
+
+ #+(or cmu scl)
+ (ext:process-exit-code
+ (ext:run-program
+ "/bin/sh"
+ (list "-c" command)
+ :input nil :output *verbose-out*))
+
+ #+allegro
+ (excl:run-shell-command command :input nil :output *verbose-out*)
+
+ #+lispworks
+ (system:call-system-showing-output
+ command
+ :shell-type "/bin/sh"
+ :output-stream *verbose-out*)
+
+ #+clisp ;XXX not exactly *verbose-out*, I know
+ (ext:run-shell-command command :output :terminal :wait t)
+
+ #+openmcl
+ (nth-value 1
+ (ccl:external-process-status
+ (ccl:run-program "/bin/sh" (list "-c" command)
+ :input nil :output *verbose-out*
+ :wait t)))
+ #+ecl ;; courtesy of Juan Jose Garcia Ripoll
+ (si:system command)
+ #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl)
+ (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
+ ))
+
+
+(defgeneric hyperdocumentation (package name doc-type))
+(defmethod hyperdocumentation ((package symbol) name doc-type)
+ (hyperdocumentation (find-package package) name doc-type))
+
+(defun hyperdoc (name doc-type)
+ (hyperdocumentation (symbol-package name) name doc-type))
+
+
+(pushnew :asdf *features*)
+
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB")
+ (pushnew :sbcl-hooks-require *features*)))
+
+#+(and sbcl sbcl-hooks-require)
+(progn
+ (defun module-provide-asdf (name)
+ (handler-bind ((style-warning #'muffle-warning))
+ (let* ((*verbose-out* (make-broadcast-stream))
+ (system (asdf:find-system name nil)))
+ (when system
+ (asdf:operate 'asdf:load-op name)
+ t))))
+
+ (pushnew
+ '(merge-pathnames "systems/"
+ (truename (sb-ext:posix-getenv "SBCL_HOME")))
+ *central-registry*)
+
+ (pushnew
+ '(merge-pathnames "site-systems/"
+ (truename (sb-ext:posix-getenv "SBCL_HOME")))
+ *central-registry*)
+
+ (pushnew
+ '(merge-pathnames ".sbcl/systems/"
+ (user-homedir-pathname))
+ *central-registry*)
+
+ (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*))
+
+(provide 'asdf)
Added: clfswm/bindings-second-mode.lisp
==============================================================================
--- (empty file)
+++ clfswm/bindings-second-mode.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,731 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Thu Feb 28 21:38:00 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Bindings keys and mouse for second mode
+;;;
+;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+;;;,-----
+;;;| Second keys
+;;;|
+;;;| CONFIG - Second mode bindings
+;;;`-----
+
+
+
+;;;;;;;;;;;;;;;
+;; Menu entry
+;;;;;;;;;;;;;;;
+(defun group-adding-menu ()
+ "Adding group menu"
+ (info-mode-menu '((#\a add-default-group)
+ (#\p add-placed-group))))
+
+(defun group-layout-menu ()
+ "Group layout menu"
+ (info-mode-menu (loop for l in *layout-list*
+ for i from 0
+ collect (list (code-char (+ (char-code #\a) i)) l))))
+
+
+
+
+
+(defun group-pack-menu ()
+ "Group pack menu"
+ (info-mode-menu '(("Up" group-pack-up)
+ ("Down" group-pack-down))))
+
+
+(defun group-movement-menu ()
+ "Group movement menu"
+ (info-mode-menu '((#\p group-pack-menu)
+ (#\f group-fill-menu)
+ (#\r group-resize-menu))))
+
+
+(defun group-pack-up ()
+ "Pack group up"
+ (print 'pack-up)
+ (group-movement-menu))
+
+(defun group-pack-down ()
+ "Pack group down"
+ (print 'pack-down)
+ (group-movement-menu))
+
+
+
+
+
+
+
+(defun action-by-name-menu ()
+ "Actions by name menu"
+ (info-mode-menu '((#\f focus-group-by-name)
+ (#\o open-group-by-name)
+ (#\d delete-group-by-name)
+ (#\m move-current-child-by-name)
+ (#\c copy-current-child-by-name))))
+
+(defun action-by-number-menu ()
+ "Actions by number menu"
+ (info-mode-menu '((#\f focus-group-by-number)
+ (#\o open-group-by-number)
+ (#\d delete-group-by-number)
+ (#\m move-current-child-by-number)
+ (#\c copy-current-child-by-number))))
+
+
+(defun group-menu ()
+ "Group menu"
+ (info-mode-menu '((#\a group-adding-menu)
+ (#\l group-layout-menu)
+ (#\m group-movement-menu))))
+
+
+
+(defun selection-menu ()
+ "Selection menu"
+ (info-mode-menu '((#\x cut-current-child)
+ (#\c copy-current-child)
+ (#\v paste-selection)
+ (#\p paste-selection-no-clear)
+ ("Delete" remove-current-child)
+ (#\z clear-selection))))
+
+
+(defun utility-menu ()
+ "Utility menu"
+ (info-mode-menu '((#\i identify-key)
+ (#\: eval-from-query-string)
+ (#\! run-program-from-query-string))))
+
+(defun main-menu ()
+ "Open the main menu"
+ (info-mode-menu '((#\g group-menu)
+ ;;(#\w window-menu)
+ (#\s selection-menu)
+ (#\n action-by-name-menu)
+ (#\u action-by-number-menu)
+ (#\y utility-menu))))
+
+
+
+
+
+
+(define-second-key ("F1" :mod-1) 'help-on-second-mode)
+
+(define-second-key ("m") 'main-menu)
+(define-second-key ("g") 'group-menu)
+(define-second-key ("n") 'action-by-name-menu)
+(define-second-key ("u") 'action-by-number-menu)
+
+
+;;(define-second-key (#\g :control) 'stop-all-pending-actions)
+
+(define-second-key (#\i) 'identify-key)
+(define-second-key (#\:) 'eval-from-query-string)
+
+(define-second-key (#\!) 'run-program-from-query-string)
+
+
+(define-second-key (#\t) 'leave-second-mode)
+(define-second-key ("Return") 'leave-second-mode)
+(define-second-key ("Escape") 'leave-second-mode)
+
+
+(define-second-key (#\< :control) 'leave-second-mode)
+
+
+
+
+(define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
+
+(define-second-key ("Right" :mod-1) 'select-next-brother)
+(define-second-key ("Left" :mod-1) 'select-previous-brother)
+
+(define-second-key ("Down" :mod-1) 'select-next-level)
+(define-second-key ("Up" :mod-1) 'select-previous-level)
+
+(define-second-key ("Tab" :mod-1) 'select-next-child)
+(define-second-key ("Tab" :mod-1 :shift) 'select-previous-child)
+
+(define-second-key ("Return" :mod-1) 'enter-group)
+(define-second-key ("Return" :mod-1 :shift) 'leave-group)
+
+(define-second-key ("Home" :mod-1) 'switch-to-root-group)
+(define-second-key ("Home" :mod-1 :shift) 'switch-and-select-root-group)
+
+(define-second-key ("Menu") 'toggle-show-root-group)
+
+(define-second-key (#\b :mod-1) 'banish-pointer)
+
+
+;;;; Escape
+(define-second-key ("Escape" :control :shift) 'delete-focus-window)
+(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window)
+(define-second-key ("Escape" :control) 'remove-focus-window)
+(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-child)
+
+
+;;; Selection
+(define-second-key ("x" :control) 'cut-current-child)
+(define-second-key ("x" :control :mod-1) 'clear-selection)
+(define-second-key ("c" :control) 'copy-current-child)
+(define-second-key ("v" :control) 'paste-selection)
+(define-second-key ("v" :control :shift) 'paste-selection-no-clear)
+(define-second-key ("Delete") 'remove-current-child)
+
+
+
+
+
+(defun sm-handle-click-to-focus (root-x root-y)
+ "Give the focus to the clicked child"
+ (let ((win (find-child-under-mouse root-x root-y)))
+ (handle-click-to-focus win)))
+
+(define-mouse-action (1) 'sm-handle-click-to-focus)
+
+
+
+
+
+
+;;;; Escape
+;;(define-second-key ("Escape" :control :shift) 'delete-current-window)
+;;(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
+;;(define-second-key ("Escape" :control) 'remove-current-window)
+;;(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
+;;
+;;
+;;;; Up
+;;(define-second-key ("Up" :mod-1) 'circulate-group-up)
+;;(define-second-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
+;;(define-second-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
+;;
+;;
+;;;; Down
+;;(define-second-key ("Down" :mod-1) 'circulate-group-down)
+;;(define-second-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
+;;(define-second-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
+;;
+;;
+;;;; Right
+;;(define-second-key ("Right" :mod-1) 'circulate-workspace-up)
+;;(define-second-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
+;;(define-second-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
+;;
+;;
+;;;; Left
+;;(define-second-key ("Left" :mod-1) 'circulate-workspace-down)
+;;(define-second-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
+;;(define-second-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
+;;
+;;
+;;(defmacro define-second-focus-workspace-by-number (key number)
+;; "Define a second key to focus a workspace by its number"
+;; `(define-second-key ,key
+;; (defun ,(create-symbol (format nil "b-second-focus-workspace-~A" number)) ()
+;; ,(format nil "Focus workspace ~A" number)
+;; (circulate-workspace-by-number ,number))))
+;;
+;;(define-second-focus-workspace-by-number (#\1 :mod-1) 1)
+;;(define-second-focus-workspace-by-number (#\2 :mod-1) 2)
+;;(define-second-focus-workspace-by-number (#\3 :mod-1) 3)
+;;(define-second-focus-workspace-by-number (#\4 :mod-1) 4)
+;;(define-second-focus-workspace-by-number (#\5 :mod-1) 5)
+;;(define-second-focus-workspace-by-number (#\6 :mod-1) 6)
+;;(define-second-focus-workspace-by-number (#\7 :mod-1) 7)
+;;(define-second-focus-workspace-by-number (#\8 :mod-1) 8)
+;;(define-second-focus-workspace-by-number (#\9 :mod-1) 9)
+;;(define-second-focus-workspace-by-number (#\0 :mod-1) 10)
+;;
+;;(define-second-key (#\1 :control :mod-1) 'renumber-workspaces)
+;;(define-second-key (#\2 :control :mod-1) 'sort-workspaces)
+;;
+;;
+;;
+;;
+;;
+;;(define-second-key ("Tab" :mod-1) 'rotate-window-up)
+;;(define-second-key ("Tab" :mod-1 :shift) 'rotate-window-down)
+;;
+;;(define-second-key (#\b) 'banish-pointer)
+;;
+;;(define-second-key (#\b :mod-1) 'toggle-maximize-current-group)
+;;
+;;(define-second-key (#\x) 'pager-mode)
+;;
+;;
+;;(define-second-key (#\k :mod-1) 'destroy-current-window)
+;;(define-second-key (#\k) 'remove-current-window)
+;;
+;;
+;;(define-second-key (#\g) 'create-new-default-group)
+;;(define-second-key (#\g :mod-1) 'remove-current-group)
+;;
+;;(define-second-key (#\w) 'create-new-default-workspace)
+;;(define-second-key (#\w :mod-1) 'remove-current-workspace)
+;;
+;;(define-second-key (#\o)
+;; (defun b-open-next-window-in-new-workspace ()
+;; "Open the next window in a new workspace"
+;; (setf *open-next-window-in-new-workspace* t)
+;; (leave-second-mode)))
+;;
+;;(define-second-key (#\o :control)
+;; (defun b-open-next-window-in-workspace-numbered ()
+;; "Open the next window in a numbered workspace"
+;; (let ((number (parse-integer (or (query-string "Open next window in workspace:") "")
+;; :junk-allowed t)))
+;; (when (numberp number)
+;; (setf *open-next-window-in-new-workspace* number)))
+;; (leave-second-mode)))
+;;
+;;
+;;(define-second-key (#\o :mod-1)
+;; (defun b-open-next-window-in-new-group-once ()
+;; "Open the next window in a new group and all others in the same group"
+;; (setf *open-next-window-in-new-group* :once)
+;; (leave-second-mode)))
+;;
+;;(define-second-key (#\o :mod-1 :control)
+;; (defun b-open-next-window-in-new-group ()
+;; "Open each next window in a new group"
+;; (setf *open-next-window-in-new-group* t)
+;; (leave-second-mode)))
+;;
+;;
+;;
+;;(defmacro define-shell (key name docstring cmd)
+;; "Define a second key to start a shell command"
+;; `(define-second-key ,key
+;; (defun ,name ()
+;; ,docstring
+;; (setf *second-mode-program* ,cmd)
+;; (leave-second-mode))))
+;;
+;;(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm")
+;;(define-shell (#\e) b-start-emacs "start emacs" "exec emacs")
+;;(define-shell (#\e :control) b-start-emacsremote
+;; "start an emacs for another user"
+;; "exec emacsremote-Eterm")
+;;(define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d")
+;;
+;;
+;;(define-second-key (#\a) 'force-window-center-in-group)
+;;(define-second-key (#\a :mod-1) 'force-window-in-group)
+;;
+;;
+;;(define-second-key (#\d :mod-1)
+;; (defun b-show-debuging-info ()
+;; "Show debuging info"
+;; (dbg *workspace-list*)
+;; (dbg *screen*)
+;; (dbg (xlib:query-tree *root*))))
+;;
+;;(define-second-key (#\t :control) 'tile-current-workspace-vertically)
+;;(define-second-key (#\t :shift :control) 'tile-current-workspace-horizontally)
+;;
+;;(define-second-key (#\y) 'tile-current-workspace-to)
+;;(define-second-key (#\y :mod-1) 'reconfigure-tile-workspace)
+;;(define-second-key (#\y :control) 'explode-current-group)
+;;(define-second-key (#\y :control :shift) 'implode-current-group)
+;;
+;;;;;,-----
+;;;;;| Moving/Resizing groups
+;;;;;`-----
+;;(define-second-key (#\p)
+;; (defun b-pack-group-on-next-arrow ()
+;; "Pack group on next arrow action"
+;; (setf *arrow-action* :pack)))
+;;
+;;
+;;(defun fill-group-in-all-directions ()
+;; "Fill group in all directions"
+;; (fill-current-group-up)
+;; (fill-current-group-left)
+;; (fill-current-group-right)
+;; (fill-current-group-down))
+;;
+;;
+;;(define-second-key (#\f)
+;; (defun b-fill-group ()
+;; "Fill group on next arrow action (fill in all directions on second f keypress)"
+;; (case *arrow-action*
+;; (:fill (fill-group-in-all-directions)
+;; (setf *arrow-action* nil))
+;; (t (setf *arrow-action* :fill)))))
+;;
+;;(define-second-key (#\f :mod-1) 'fill-group-in-all-directions)
+;;
+;;(define-second-key (#\f :shift)
+;; (defun b-fill-group-vert ()
+;; "Fill group vertically"
+;; (fill-current-group-up)
+;; (fill-current-group-down)))
+;;
+;;(define-second-key (#\f :control)
+;; (defun b-fill-group-horiz ()
+;; "Fill group horizontally"
+;; (fill-current-group-left)
+;; (fill-current-group-right)))
+;;
+;;
+;;(define-second-key (#\r)
+;; (defun b-resize-half ()
+;; "Resize group to its half width or heigth on next arraw action"
+;; (setf *arrow-action* :resize-half)))
+;;
+;;
+;;(define-second-key (#\l) 'resize-minimal-current-group)
+;;(define-second-key (#\l :mod-1) 'resize-down-current-group)
+;;
+;;
+;;(define-second-key (#\m) 'center-current-group)
+;;
+;;
+;;(define-second-key ("Up")
+;; (defun b-move-or-pack-up ()
+;; "Move, pack, fill or resize group up"
+;; (case *arrow-action*
+;; (:pack (pack-current-group-up))
+;; (:fill (fill-current-group-up))
+;; (:resize-half (resize-half-height-up-current-group))
+;; (t (move-group (current-group) 0 -10)))
+;; (setf *arrow-action* nil)))
+;;
+;;(define-second-key ("Down")
+;; (defun b-move-or-pack-down ()
+;; "Move, pack, fill or resize group down"
+;; (case *arrow-action*
+;; (:pack (pack-current-group-down))
+;; (:fill (fill-current-group-down))
+;; (:resize-half (resize-half-height-down-current-group))
+;; (t (move-group (current-group) 0 +10)))
+;; (setf *arrow-action* nil)))
+;;
+;;(define-second-key ("Right")
+;; (defun b-move-or-pack-right ()
+;; "Move, pack, fill or resize group right"
+;; (case *arrow-action*
+;; (:pack (pack-current-group-right))
+;; (:fill (fill-current-group-right))
+;; (:resize-half (resize-half-width-right-current-group))
+;; (t (move-group (current-group) +10 0)))
+;; (setf *arrow-action* nil)))
+;;
+;;(define-second-key ("Left")
+;; (defun b-move-or-pack-left ()
+;; "Move, pack, fill or resize group left"
+;; (case *arrow-action*
+;; (:pack (pack-current-group-left))
+;; (:fill (fill-current-group-left))
+;; (:resize-half (resize-half-width-left-current-group))
+;; (t (move-group (current-group) -10 0)))
+;; (setf *arrow-action* nil)))
+;;
+;;
+;;(define-second-key ("Up" :shift)
+;; (defun b-resize-up ()
+;; "Resize group up"
+;; (resize-group (current-group) 0 -10)))
+;;
+;;(define-second-key ("Down" :shift)
+;; (defun b-resize-down ()
+;; "Resize group down"
+;; (resize-group (current-group) 0 +10)))
+;;
+;;(define-second-key ("Right" :shift)
+;; (defun b-resize-right ()
+;; "Resize group right"
+;; (resize-group (current-group) +10 0)))
+;;
+;;(define-second-key ("Left" :shift)
+;; (defun b-resize-left ()
+;; "Resize group left"
+;; (resize-group (current-group) -10 0)))
+;;
+;;
+;;;;;,-----
+;;;;;| Mouse second mode functions
+;;;;;`-----
+;;(defun select-group-under-mouse (root-x root-y)
+;; (let ((group (find-group-under-mouse root-x root-y)))
+;; (when group
+;; (no-focus)
+;; (focus-group group (current-workspace))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace) nil))))
+;;
+;;(defun mouse-leave-second-mode-maximize (root-x root-y)
+;; "Leave second mode and maximize current group"
+;; (select-group-under-mouse root-x root-y)
+;; (maximize-group (current-group))
+;; (show-all-windows-in-workspace (current-workspace))
+;; (throw 'exit-second-loop nil))
+;;
+;;(defun mouse-leave-second-mode (root-x root-y)
+;; "Leave second mode"
+;; (select-group-under-mouse root-x root-y)
+;; (show-all-windows-in-workspace (current-workspace))
+;; (throw 'exit-second-loop nil))
+;;
+;;
+;;
+;;
+;;(defun mouse-circulate-window-up (root-x root-y)
+;; "Rotate window up"
+;; (declare (ignore root-x root-y))
+;; (rotate-window-up))
+;;
+;;
+;;(defun mouse-circulate-window-down (root-x root-y)
+;; "Rotate window down"
+;; (declare (ignore root-x root-y))
+;; (rotate-window-down))
+;;
+;;
+;;
+;;(defun mouse-circulate-workspace-up (root-x root-y)
+;; "Circulate up in workspaces"
+;; (declare (ignore root-x root-y))
+;; (circulate-workspace-up))
+;;
+;;
+;;(defun mouse-circulate-workspace-down (root-x root-y)
+;; "Circulate down in workspaces"
+;; (declare (ignore root-x root-y))
+;; (circulate-workspace-down))
+;;
+;;
+;;
+;;
+;;(defun init-motion-vars ()
+;; (setf *motion-action* nil
+;; *motion-object* nil
+;; *motion-start-group* nil
+;; *motion-dx* nil
+;; *motion-dy* nil))
+;;
+;;
+;;(let ((accept-motion t)
+;; (selected-group nil))
+;; (defun mouse-motion (root-x root-y)
+;; "Move or resize group. Move window from a group to another.
+;;Go to top left or rigth corner to change workspaces."
+;; (let ((group (find-group-under-mouse root-x root-y)))
+;; (unless (equal selected-group group)
+;; (select-group-under-mouse root-x root-y)
+;; (setf selected-group group)))
+;; (if (<= root-y 5)
+;; (cond ((and accept-motion (<= root-x 5))
+;; (case *motion-action*
+;; (:move-group
+;; (remove-group-in-workspace *motion-object* (current-workspace))))
+;; (circulate-workspace-down)
+;; (minimize-group (current-group))
+;; (case *motion-action*
+;; (:move-group
+;; (add-group-in-workspace *motion-object* (current-workspace))))
+;; (warp-pointer *root* (1- (xlib:screen-width *screen*)) 100)
+;; (setf accept-motion nil))
+;; ((and accept-motion (>= root-x (- (xlib:screen-width *screen*) 5)))
+;; (case *motion-action*
+;; (:move-group
+;; (remove-group-in-workspace *motion-object* (current-workspace))))
+;; (circulate-workspace-up)
+;; (minimize-group (current-group))
+;; (case *motion-action*
+;; (:move-group
+;; (add-group-in-workspace *motion-object* (current-workspace))))
+;; (warp-pointer *root* 0 100)
+;; (setf accept-motion nil))
+;; (t (setf accept-motion t)))
+;; (setf accept-motion t))
+;; (case *motion-action*
+;; (:move-group
+;; (hide-group *root* *motion-object*)
+;; (setf (group-x *motion-object*) (+ root-x *motion-dx*)
+;; (group-y *motion-object*) (+ root-y *motion-dy*))
+;; (show-group *root* *root-gc* *motion-object*)
+;; (adapt-all-window-in-group *motion-object*)
+;; (show-all-group (current-workspace) nil))
+;; (:resize-group
+;; (hide-group *root* *motion-object*)
+;; (setf (group-width *motion-object*) (max (+ (group-width *motion-object*) (- root-x *motion-dx*)) 100)
+;; (group-height *motion-object*) (max (+ (group-height *motion-object*) (- root-y *motion-dy*)) 100)
+;; *motion-dx* root-x *motion-dy* root-y)
+;; (show-group *root* *root-gc* *motion-object*)
+;; (adapt-all-window-in-group *motion-object*)
+;; (show-all-group (current-workspace) nil)))))
+;;
+;;
+;;
+;;(defun move-selected-group (root-x root-y)
+;; "Move selected group or create a new group on the root window"
+;; (select-group-under-mouse root-x root-y)
+;; (setf *motion-object* (find-group-under-mouse root-x root-y))
+;; (if *motion-object*
+;; (setf *motion-action* :move-group
+;; *motion-dx* (- (group-x *motion-object*) root-x)
+;; *motion-dy* (- (group-y *motion-object*) root-y))
+;; (progn
+;; (setf *motion-object* (make-group :x root-x :y root-y :width 100 :height 100 :fullscreenp nil))
+;; (warp-pointer *root* (+ root-x 100) (+ root-y 100))
+;; (add-group-in-workspace *motion-object* (current-workspace))
+;; (show-all-group (current-workspace))
+;; (setf *motion-action* :resize-group
+;; *motion-dx* (+ root-x 100)
+;; *motion-dy* (+ root-y 100)))))
+;;
+;;
+;;
+;;(defun copy-selected-group (root-x root-y)
+;; "Copy selected group"
+;; (xgrab-pointer *root* 50 51)
+;; (select-group-under-mouse root-x root-y)
+;; (setf *motion-object* (find-group-under-mouse root-x root-y))
+;; (when *motion-object*
+;; (setf *motion-action* :copy-group
+;; *motion-object* (copy-group *motion-object*)
+;; *motion-dx* (- (group-x *motion-object*) root-x)
+;; *motion-dy* (- (group-y *motion-object*) root-y))))
+;;;; (add-group-in-workspace *motion-object* (current-workspace))))
+;;
+;;
+;;
+;;(defun release-move-selected-group (root-x root-y)
+;; "Release button"
+;; (when *motion-object*
+;; (case *motion-action*
+;; (:move-group
+;; (move-group-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*)))
+;; (:resize-group
+;; (resize-group *motion-object* 0 0))))
+;; (init-motion-vars)
+;; (select-group-under-mouse root-x root-y))
+;;
+;;
+;;(defun release-copy-selected-group (root-x root-y)
+;; "Release button"
+;; (xgrab-pointer *root* 66 67)
+;; (when *motion-object*
+;; (unless (group-windows-already-in-workspace *motion-object* (current-workspace))
+;; (add-group-in-workspace *motion-object* (current-workspace))
+;; (move-group-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*))))
+;; (init-motion-vars)
+;; (select-group-under-mouse root-x root-y)
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;(defun resize-selected-group (root-x root-y)
+;; "Resize selected group"
+;; (select-group-under-mouse root-x root-y)
+;; (setf *motion-object* (find-group-under-mouse root-x root-y))
+;; (when *motion-object*
+;; (setf *motion-action* :resize-group
+;; *motion-dx* root-x
+;; *motion-dy* root-y)))
+;;
+;;
+;;(defun release-resize-selected-group (root-x root-y)
+;; "Release button"
+;; (when *motion-object*
+;; (resize-group *motion-object* 0 0))
+;; (init-motion-vars)
+;; (select-group-under-mouse root-x root-y))
+;;
+;;
+;;
+;;(defun move-selected-window (root-x root-y)
+;; "Move selected window"
+;; (xgrab-pointer *root* 50 51)
+;; (select-group-under-mouse root-x root-y)
+;; (setf *motion-object* (current-window)
+;; *motion-action* :move-window)
+;; (when *motion-object*
+;; (setf *motion-start-group* (current-group))))
+;;
+;;
+;;(defun release-move-selected-window (root-x root-y)
+;; "Release button"
+;; (xgrab-pointer *root* 66 67)
+;; (select-group-under-mouse root-x root-y)
+;; (when *motion-object*
+;; (remove-window-in-group *motion-object* *motion-start-group*)
+;; (add-window-in-group *motion-object* (current-group)))
+;; (init-motion-vars)
+;; (select-group-under-mouse root-x root-y)
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;(defun copy-selected-window (root-x root-y)
+;; "Copy selected window"
+;; (move-selected-window root-x root-y)
+;; (setf *motion-action* :copy-window))
+;;
+;;(defun release-copy-selected-window (root-x root-y)
+;; "Release button"
+;; (xgrab-pointer *root* 66 67)
+;; (select-group-under-mouse root-x root-y)
+;; (when *motion-object*
+;; (unless (window-already-in-workspace *motion-object* (current-workspace))
+;; (add-window-in-group *motion-object* (current-group))))
+;; (init-motion-vars)
+;; (select-group-under-mouse root-x root-y)
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;
+;;
+;;
+;;(define-mouse-action (1) 'move-selected-group 'release-move-selected-group)
+;;(define-mouse-action (1 :mod-1) 'resize-selected-group 'release-resize-selected-group)
+;;(define-mouse-action (1 :control) 'copy-selected-group 'release-copy-selected-group)
+;;
+;;(define-mouse-action (2) nil 'mouse-leave-second-mode-maximize)
+;;(define-mouse-action (2 :control) nil 'mouse-leave-second-mode)
+;;
+;;(define-mouse-action (3) 'move-selected-window 'release-move-selected-window)
+;;(define-mouse-action (3 :control) 'copy-selected-window 'release-copy-selected-window)
+;;
+;;
+;;(define-mouse-action (4) 'mouse-circulate-window-up nil)
+;;(define-mouse-action (5) 'mouse-circulate-window-down nil)
+;;
+;;(define-mouse-action (4 :mod-1) 'mouse-circulate-workspace-up nil)
+;;(define-mouse-action (5 :mod-1) 'mouse-circulate-workspace-down nil)
+;;
+;;(define-mouse-action ('Motion) 'mouse-motion nil)
+
Added: clfswm/bindings.lisp
==============================================================================
--- (empty file)
+++ clfswm/bindings.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,173 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Sun Feb 24 21:34:48 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Bindings keys and mouse
+;;;
+;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+;;;,-----
+;;;| CONFIG - Bindings main mode
+;;;`-----
+
+
+(define-main-key ("F1" :mod-1) 'help-on-clfswm)
+
+(defun quit-clfswm ()
+ "Quit clfswm"
+ (throw 'exit-main-loop nil))
+
+(define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
+
+(define-main-key ("Right" :mod-1) 'select-next-brother)
+(define-main-key ("Left" :mod-1) 'select-previous-brother)
+
+(define-main-key ("Down" :mod-1) 'select-next-level)
+(define-main-key ("Up" :mod-1) 'select-previous-level)
+
+(define-main-key ("Tab" :mod-1) 'select-next-child)
+(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
+
+(define-main-key ("Return" :mod-1) 'enter-group)
+(define-main-key ("Return" :mod-1 :shift) 'leave-group)
+
+(define-main-key ("Home" :mod-1) 'switch-to-root-group)
+(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-group)
+
+(define-main-key ("Menu") 'toggle-show-root-group)
+
+(define-main-key (#\b :mod-1) 'banish-pointer)
+
+
+;;;; Escape
+(define-main-key ("Escape" :control :shift) 'delete-focus-window)
+(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window)
+(define-main-key ("Escape" :control) 'remove-focus-window)
+(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-child)
+
+
+(define-main-key (#\t :mod-1) 'second-key-mode)
+(define-main-key ("less" :control) 'second-key-mode)
+
+
+;;(define-main-key ("a") (lambda ()
+;; (dbg 'key-a)
+;; (show-all-childs *root-group*)))
+;;
+;;(define-main-key ("b") (lambda ()
+;; (dbg 'key-b)
+;; (let* ((window (xlib:create-window :parent *root*
+;; :x 300
+;; :y 200
+;; :width 400
+;; :height 300
+;; :background (get-color "Black")
+;; :colormap (xlib:screen-default-colormap *screen*)
+;; :border-width 1
+;; :border (get-color "Red")
+;; :class :input-output
+;; :event-mask '(:exposure)))
+;; (gc (xlib:create-gcontext :drawable window
+;; :foreground (get-color "Green")
+;; :background (get-color "Red")
+;; :font *default-font*
+;; :line-style :solid)))
+;; (xlib:map-window window)
+;; (draw-line window gc 10 10 200 200)
+;; (xlib:display-finish-output *display*)
+;; (xlib:draw-glyphs window gc 10 10 (format nil "~A" 10))
+;; (dbg 'ici))))
+;;
+;;
+;;;;(define-main-key ("F1" :mod-1) 'help-on-clfswm)
+;;;;
+;;(defun quit-clfswm ()
+;; "Quit clfswm"
+;; (throw 'exit-main-loop nil))
+;;
+;;
+;;
+;;(define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
+;;
+;;(define-main-key (#\t :mod-1) 'second-key-mode)
+;;(define-main-key ("less" :control) 'second-key-mode)
+;;
+;;(define-main-key ("Tab" :mod-1) 'rotate-window-up)
+;;(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
+;;
+;;(define-main-key (#\b :mod-1) 'banish-pointer)
+;;(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
+;;
+;;;; Escape
+;;(define-main-key ("Escape" :control :shift) 'delete-current-window)
+;;(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
+;;(define-main-key ("Escape" :control) 'remove-current-window)
+;;(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
+;;
+;;
+;;;; Up
+;;(define-main-key ("Up" :mod-1) 'circulate-group-up)
+;;(define-main-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
+;;(define-main-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
+;;
+;;
+;;;; Down
+;;(define-main-key ("Down" :mod-1) 'circulate-group-down)
+;;(define-main-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
+;;(define-main-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
+;;
+;;
+;;;; Right
+;;(define-main-key ("Right" :mod-1) 'circulate-workspace-up)
+;;(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
+;;(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
+;;
+;;
+;;;; Left
+;;(define-main-key ("Left" :mod-1) 'circulate-workspace-down)
+;;(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
+;;(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
+;;
+;;
+;;
+;;(defmacro define-main-focus-workspace-by-number (key number)
+;; "Define a main key to focus a workspace by its number"
+;; `(define-main-key ,key
+;; (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) ()
+;; ,(format nil "Focus workspace ~A" number)
+;; (circulate-workspace-by-number ,number))))
+;;
+;;(define-main-focus-workspace-by-number (#\1 :mod-1) 1)
+;;(define-main-focus-workspace-by-number (#\2 :mod-1) 2)
+;;(define-main-focus-workspace-by-number (#\3 :mod-1) 3)
+;;(define-main-focus-workspace-by-number (#\4 :mod-1) 4)
+;;(define-main-focus-workspace-by-number (#\5 :mod-1) 5)
+;;(define-main-focus-workspace-by-number (#\6 :mod-1) 6)
+;;(define-main-focus-workspace-by-number (#\7 :mod-1) 7)
+;;(define-main-focus-workspace-by-number (#\8 :mod-1) 8)
+;;(define-main-focus-workspace-by-number (#\9 :mod-1) 9)
+;;(define-main-focus-workspace-by-number (#\0 :mod-1) 10)
+
Added: clfswm/check-diff.sh
==============================================================================
--- (empty file)
+++ clfswm/check-diff.sh Sat Mar 1 07:49:46 2008
@@ -0,0 +1,12 @@
+#!/bin/sh
+
+DIR=../clfswm2
+
+for i in *
+do
+ diff $i $DIR/$i > /dev/null
+ if [ $? = 1 ]; then
+ echo $i
+ #cp $DIR/$i .
+ fi
+done
Added: clfswm/clfswm-info.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-info.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,444 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 19 21:43:15 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Info function (see the end of this file for user definition
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defstruct info window gc font list ilw ilh x y)
+
+
+(defun leave-info-mode (info)
+ "Leave the info mode"
+ (declare (ignore info))
+ (throw 'exit-info-loop nil))
+
+(defun mouse-leave-info-mode (root-x root-y info)
+ "Leave the info mode"
+ (declare (ignore root-x root-y info))
+ (throw 'exit-info-loop nil))
+
+
+
+(defun draw-info-window (info)
+ (xlib:clear-area (info-window info))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+ (loop for line in (info-list info)
+ for y from 0 do
+ (xlib:draw-image-glyphs (info-window info) (info-gc info)
+ (- (info-ilw info) (info-x info))
+ (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
+ (format nil "~A" line))))
+
+
+(defun draw-info-window-partial (info)
+ (let ((last-y (info-y info)))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info) 0 0
+ (xlib:drawable-width (info-window info))
+ (max (+ (- (info-y info)) (xlib:max-char-ascent (info-font info))) 0) t)
+ (loop for line in (info-list info)
+ for y from 0 do
+ (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info)
+ 0 (+ last-y (- (info-ilh info)) (xlib:max-char-descent (info-font info)))
+ (xlib:drawable-width (info-window info)) (info-ilh info) t)
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+ (xlib:draw-image-glyphs (info-window info) (info-gc info)
+ (- (info-ilw info) (info-x info))
+ last-y
+ (format nil "~A" line)))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info) 0 last-y
+ (xlib:drawable-width (info-window info))
+ (xlib:drawable-height (info-window info))
+ t)))
+
+
+;;;,-----
+;;;| Key binding
+;;;`-----
+
+(define-info-key (#\q) 'leave-info-mode)
+(define-info-key ("Return") 'leave-info-mode)
+(define-info-key ("Escape") 'leave-info-mode)
+(define-info-key (#\Space) 'leave-info-mode)
+
+(define-info-key ("twosuperior")
+ (defun info-banish-pointer (info)
+ "Move the pointer to the lower right corner of the screen"
+ (declare (ignore info))
+ (banish-pointer)))
+
+(define-info-key ("Down")
+ (defun info-next-line (info)
+ "Move one line down"
+ (incf (info-y info) (info-ilh info))
+ (draw-info-window info)))
+
+(define-info-key ("Up")
+ (defun info-previous-line (info)
+ "Move one line up"
+ (decf (info-y info) (info-ilh info))
+ (draw-info-window info)))
+
+(define-info-key ("Left")
+ (defun info-previous-char (info)
+ "Move one char left"
+ (decf (info-x info) (info-ilw info))
+ (draw-info-window info)))
+
+(define-info-key ("Right")
+ (defun info-next-char (info)
+ "Move one char right"
+ (incf (info-x info) (info-ilw info))
+ (draw-info-window info)))
+
+
+(define-info-key ("Home")
+ (defun info-first-line (info)
+ "Move to first line"
+ (setf (info-x info) 0
+ (info-y info) 0)
+ (draw-info-window info)))
+
+(define-info-key ("End")
+ (defun info-end-line (info)
+ "Move to last line"
+ (setf (info-x info) 0
+ (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib:drawable-height (info-window info))))
+ (draw-info-window info)))
+
+
+(define-info-key ("Page_Down")
+ (defun info-next-ten-lines (info)
+ "Move ten lines down"
+ (incf (info-y info) (* (info-ilh info) 10))
+ (draw-info-window info)))
+
+(define-info-key ("Page_Up")
+ (defun info-previous-ten-lines (info)
+ "Move ten lines up"
+ (decf (info-y info) (* (info-ilh info) 10))
+ (draw-info-window info)))
+
+
+
+
+(defparameter *info-start-grab-x* nil)
+(defparameter *info-start-grab-y* nil)
+
+
+(defun info-begin-grab (root-x root-y info)
+ "Begin grab text"
+ (setf *info-start-grab-x* (+ root-x (info-x info))
+ *info-start-grab-y* (+ root-y (info-y info)))
+ (draw-info-window info))
+
+(defun info-end-grab (root-x root-y info)
+ "End grab"
+ (setf (info-x info) (- *info-start-grab-x* root-x)
+ (info-y info) (- *info-start-grab-y* root-y)
+ *info-start-grab-x* nil
+ *info-start-grab-y* nil)
+ (draw-info-window info))
+
+(defun info-mouse-next-line (root-x root-y info)
+ "Move one line down"
+ (declare (ignore root-x root-y))
+ (incf (info-y info) (info-ilh info))
+ (draw-info-window info))
+
+(defun info-mouse-previous-line (root-x root-y info)
+ "Move one line up"
+ (declare (ignore root-x root-y))
+ (decf (info-y info) (info-ilh info))
+ (draw-info-window info))
+
+
+(defun info-mouse-motion (root-x root-y info)
+ "Grab text"
+ (when (and *info-start-grab-x* *info-start-grab-y*)
+ (setf (info-x info) (- *info-start-grab-x* root-x)
+ (info-y info) (- *info-start-grab-y* root-y))
+ (draw-info-window-partial info)))
+
+
+
+
+
+(define-info-mouse-action (1) 'info-begin-grab 'info-end-grab)
+(define-info-mouse-action (2) 'mouse-leave-info-mode)
+(define-info-mouse-action (4) 'info-mouse-previous-line)
+(define-info-mouse-action (5) 'info-mouse-next-line)
+(define-info-mouse-action ('Motion) 'info-mouse-motion nil)
+
+
+;;;,-----
+;;;| Main mode
+;;;`-----
+
+(defun info-mode (info-list &key (x 0) (y 0) (width nil) (height nil))
+ "Open the info mode. Info-list is a list of info: One string per line"
+ (when info-list
+ (let* ((pointer-grabbed (xgrab-pointer-p))
+ (keyboard-grabbed (xgrab-keyboard-p))
+ (font (xlib:open-font *display* *info-font-string*))
+ (ilw (xlib:max-char-width font))
+ (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
+ (window (xlib:create-window :parent *root*
+ :x x :y y
+ :width (or width
+ (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
+ (- (xlib:screen-width *screen*) 2 x)))
+ :height (or height
+ (min (+ (* (length info-list) ilh) (/ ilh 2))
+ (- (xlib:screen-height *screen*) 2 y)))
+ :background (get-color *info-background*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :border-width 1
+ :border (get-color *info-border*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *info-foreground*)
+ :background (get-color *info-background*)
+ :font font
+ :line-style :solid))
+ (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
+ :font font :ilw ilw :ilh ilh)))
+ (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (funcall-key-from-code *info-keys* code state info))
+ (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
+ (:motion-notify () t))
+ (funcall-button-from-code *info-mouse-action* 'motion 0 root-x root-y #'first info)))
+ (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *info-mouse-action* code state root-x root-y #'first info))
+ (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *info-mouse-action* code state root-x root-y #'third info))
+ (info-handle-unmap-notify (&rest event-slots)
+ (apply #'handle-unmap-notify event-slots)
+ (draw-info-window info))
+ (info-handle-destroy-notify (&rest event-slots)
+ (apply #'handle-destroy-notify event-slots)
+ (draw-info-window info))
+ (handle-events (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-key event-slots) t)
+ (:button-press (apply #'handle-button-press event-slots) t)
+ (:button-release (apply #'handle-button-release event-slots) t)
+ (:motion-notify (apply #'handle-motion-notify event-slots) t)
+ (:map-request nil)
+ (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
+ (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
+ (:mapping-notify nil)
+ (:property-notify nil)
+ (:create-notify nil)
+ (:enter-notify nil)
+ (:exposure (draw-info-window info)))
+ t))
+ (xlib:map-window window)
+ (draw-info-window info)
+ (xgrab-pointer *root* 68 69)
+ (unless keyboard-grabbed
+ (xgrab-keyboard *root*))
+ (unwind-protect
+ (catch 'exit-info-loop
+ (loop
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-events)))
+ (if pointer-grabbed
+ (xgrab-pointer *root* 66 67)
+ (xungrab-pointer))
+ (unless keyboard-grabbed
+ (xungrab-keyboard))
+ (xlib:free-gcontext gc)
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (show-all-childs)
+ (wait-no-key-or-button-press))))))
+
+
+
+
+
+
+(defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
+ "Open an info help menu.
+Item-list is: '((key function) (key function))
+key is a character, a keycode or a keysym"
+ (let ((info-list nil)
+ (action nil))
+ (dolist (item item-list)
+ (destructuring-bind (key function) item
+ (push (format nil "~A: ~A" key (documentation function 'function))
+ info-list)
+ (define-info-key-fun (list key 0)
+ (lambda (&optional args)
+ (declare (ignore args))
+ (setf action function)
+ (throw 'exit-info-loop nil)))))
+ (info-mode (nreverse info-list) :x x :y y :width width :height height)
+ (dolist (item item-list)
+ (let ((key (first item)))
+ (undefine-info-key-fun (list key 0))))
+ (when (fboundp action)
+ (funcall action))))
+
+
+
+
+
+;;;,-----
+;;;| CONFIG - Info mode functions
+;;;`-----
+(defun append-space (string)
+ "Append spaces before Newline on each line"
+ (with-output-to-string (stream)
+ (loop for c across string do
+ (when (equal c #\Newline)
+ (princ " " stream))
+ (princ c stream))))
+
+
+(defun show-key-binding (&rest hash-table-key)
+ "Show the binding of each hash-table-key"
+ (info-mode (split-string (append-space (with-output-to-string (stream)
+ (produce-doc hash-table-key
+ stream)))
+ #\Newline)))
+
+
+(defun show-global-key-binding ()
+ "Show all key binding"
+ (show-key-binding *main-keys* *second-keys* *mouse-action*
+ *info-keys* *info-mouse-action*))
+
+(defun show-main-mode-key-binding ()
+ "Show the main mode binding"
+ (show-key-binding *main-keys*))
+
+(defun show-second-mode-key-binding ()
+ "Show the second mode key binding"
+ (show-key-binding *second-keys* *mouse-action*))
+
+
+(let ((days '("Lundi" "Mardi" "Mercredi" "Jeudi" "Vendredi" "Samedi" "Dimanche"))
+ (months '("Janvier" "Fevrier" "Mars" "Avril" "Mai" "Juin" "Juillet"
+ "Aout" "Septembre" "Octobre" "Novembre" "Decembre")))
+ (defun date-string ()
+ (multiple-value-bind (second minute hour date month year day)
+ (get-decoded-time)
+ (format nil " ~2,'0D:~2,'0D:~2,'0D ~A ~2,'0D ~A ~A "
+ hour minute second
+ (nth day days) date (nth (1- month) months) year))))
+
+
+(defun show-date ()
+ "Show the current time and date"
+ (info-mode (list (date-string))))
+
+
+
+
+
+
+(defun info-on-shell (program)
+ (let ((lines (do-shell program nil t)))
+ (info-mode (loop for line = (read-line lines nil nil)
+ while line
+ collect line))))
+
+
+(defun show-cpu-proc ()
+ "Show current processes sorted by CPU usage"
+ (info-on-shell "ps --cols=1000 --sort='-%cpu,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
+
+(defun show-mem-proc ()
+ "Show current processes sorted by memory usage"
+ (info-on-shell "ps --cols=1000 --sort='-vsz,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
+
+(defun show-xmms-status ()
+ "Show the current xmms status"
+ (info-on-shell "xmms-shell -e status"))
+
+(defun show-xmms-playlist ()
+ "Show the current xmms playlist"
+ (info-on-shell "xmms-shell -e list"))
+
+
+(defun xmms-info-menu ()
+ "Open the xmms menu"
+ (info-mode-menu '((#\s show-xmms-status)
+ (#\l show-xmms-playlist))))
+
+
+
+(defun show-cd-info ()
+ "Show the current CD track"
+ (info-on-shell "pcd i"))
+
+(defun show-cd-playlist ()
+ "Show the current CD playlist"
+ (info-on-shell "pcd mi"))
+
+(defun info-on-cd-menu ()
+ "Open the CD info menu"
+ (info-mode-menu '((#\i show-cd-info)
+ (#\l show-cd-playlist))))
+
+
+
+(defun help-on-clfswm ()
+ "Open the help and info window"
+ (info-mode-menu '((#\h show-global-key-binding)
+ (#\b show-main-mode-key-binding)
+ (#\t show-date)
+ (#\c show-cpu-proc)
+ (#\m show-mem-proc)
+ (#\x xmms-info-menu)
+ (#\d info-on-cd-menu))))
+
+
+(defun help-on-second-mode ()
+ "Open the help and info window"
+ (info-mode-menu '((#\h show-global-key-binding)
+ (#\b show-second-mode-key-binding)
+ (#\t show-date)
+ (#\c show-cpu-proc)
+ (#\m show-mem-proc)
+ (#\x xmms-info-menu)
+ (#\d info-on-cd-menu))))
+
+
+
+
+
Added: clfswm/clfswm-internal.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-internal.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,642 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Sat Mar 1 00:03:14 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Main functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+;;; Minimal hook
+(defun call-hook (hook &optional args)
+ "Call a hook (a function, a symbol or a list of function)"
+ (typecase hook
+ (list (dolist (h hook)
+ (apply 'call-hook (list h args))))
+ (t (apply hook args))))
+
+
+;;; Group data manipulation functions
+(defun group-data-slot (group slot)
+ "Return the value associated to data slot"
+ (when (group-p group)
+ (second (assoc slot (group-data group)))))
+
+(defun set-group-data-slot (group slot value)
+ "Set the value associated to data slot"
+ (when (group-p group)
+ (with-slots (data) group
+ (setf data (remove (assoc slot data) data))
+ (push (list slot value) data))
+ value))
+
+(defsetf group-data-slot set-group-data-slot)
+
+
+
+(defgeneric group-p (group))
+(defmethod group-p ((group group))
+ (declare (ignore group))
+ t)
+(defmethod group-p (group)
+ (declare (ignore group))
+ nil)
+
+
+
+(defgeneric child-name (child))
+
+(defmethod child-name ((child xlib:window))
+ (xlib:wm-name child))
+
+(defmethod child-name ((child group))
+ (group-name child))
+
+(defmethod child-name (child)
+ (declare (ignore child))
+ "???")
+
+
+
+;; (with-all-childs (*root-group* child) (typecase child (xlib:window (print child)) (group (print (group-number child)))))
+(defmacro with-all-childs ((root child) &body body)
+ (let ((rec (gensym))
+ (sub-child (gensym)))
+ `(labels ((,rec (,child)
+ , at body
+ (when (group-p ,child)
+ (dolist (,sub-child (group-child ,child))
+ (,rec ,sub-child)))))
+ (,rec ,root))))
+
+
+;; (with-all-group (*root-group* group) (print (group-number group)))
+(defmacro with-all-groups ((root group) &body body)
+ (let ((rec (gensym))
+ (child (gensym)))
+ `(labels ((,rec (,group)
+ (when (group-p ,group)
+ , at body
+ (dolist (,child (group-child ,group))
+ (,rec ,child)))))
+ (,rec ,root))))
+
+
+;; (with-all-windows (*root-group* window) (print window))
+(defmacro with-all-windows ((root window) &body body)
+ (let ((rec (gensym))
+ (child (gensym)))
+ `(labels ((,rec (,window)
+ (when (xlib:window-p ,window)
+ , at body)
+ (when (group-p ,window)
+ (dolist (,child (group-child ,window))
+ (,rec ,child)))))
+ (,rec ,root))))
+
+
+
+;; (with-all-groups-windows (*root-group* child) (print child) (print (group-number child)))
+(defmacro with-all-windows-groups ((root child) body-window body-group)
+ (let ((rec (gensym))
+ (sub-child (gensym)))
+ `(labels ((,rec (,child)
+ (typecase ,child
+ (xlib:window ,body-window)
+ (group ,body-group
+ (dolist (,sub-child (group-child ,child))
+ (,rec ,sub-child))))))
+ (,rec ,root))))
+
+
+
+(defun group-find-free-number ()
+ (let ((all-numbers nil))
+ (with-all-groups (*root-group* group)
+ (push (group-number group) all-numbers))
+ (find-free-number all-numbers)))
+
+
+
+(defun create-group (&key name (number (group-find-free-number)) (x 0.1) (y 0.1) (w 0.8) (h 0.8) layout)
+ (let* ((window (xlib:create-window :parent *root*
+ :x 0
+ :y 0
+ :width 200
+ :height 200
+ :background (get-color "Black")
+ :colormap (xlib:screen-default-colormap *screen*)
+ :border-width 1
+ :border (get-color "Red")
+ :event-mask '(:exposure :button-press)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color "Green")
+ :background (get-color "Black")
+ :font *default-font*
+ :line-style :solid)))
+ (make-instance 'group :name name :number number
+ :x x :y y :w w :h h :window window :gc gc :layout layout)))
+
+
+(defun add-group (group father)
+ (push group (group-child father)))
+
+
+
+
+
+
+(defun get-current-child ()
+ "Return the current focused child"
+ (unless (equal *current-child* *root-group*)
+ (typecase *current-child*
+ (xlib:window *current-child*)
+ (group (if (xlib:window-p (first (group-child *current-child*)))
+ (first (group-child *current-child*))
+ *current-child*)))))
+
+
+(defun find-child (to-find root)
+ "Find to-find in root or in its childs"
+ (with-all-childs (root child)
+ (when (equal child to-find)
+ (return-from find-child t))))
+
+
+
+(defun find-father-group (to-find &optional (root *root-group*))
+ "Return the father group of to-find"
+ (with-all-groups (root group)
+ (when (member to-find (group-child group))
+ (return-from find-father-group group))))
+
+
+
+(defun find-group-window (window &optional (root *root-group*))
+ "Return the group with the window window"
+ (with-all-groups (root group)
+ (when (xlib:window-equal window (group-window group))
+ (return-from find-group-window group))))
+
+
+(defun find-group-by-name (name)
+ "Find a group from its name"
+ (when name
+ (with-all-groups (*root-group* group)
+ (when (string-equal name (group-name group))
+ (return-from find-group-by-name group)))))
+
+(defun find-group-by-number (number)
+ "Find a group from its number"
+ (when (numberp number)
+ (with-all-groups (*root-group* group)
+ (when (= number (group-number group))
+ (return-from find-group-by-number group)))))
+
+
+
+
+(defun get-all-windows (&optional (root *root-group*))
+ "Return all windows in root and in its childs"
+ (let ((acc nil))
+ (with-all-windows (root window)
+ (push window acc))
+ acc))
+
+
+(defun get-hidden-windows ()
+ "Return all hiddens windows"
+ (let ((all-windows (get-all-windows))
+ (hidden-windows (remove-if-not #'window-hidden-p
+ (copy-list (xlib:query-tree *root*)))))
+ (set-difference hidden-windows all-windows)))
+
+
+
+
+(defun display-group-info (group)
+ (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
+ (with-slots (name number gc window child) group
+ (when (equal group *current-root*)
+ (xlib:clear-area window))
+ (xlib:with-gcontext (gc :foreground (get-color (if (and (equal group *current-root*)
+ (equal group *current-child*))
+ "Red" "Green")))
+ (xlib:draw-image-glyphs window gc 5 dy
+ (format nil "Group: ~A~A "
+ number
+ (if name (format nil " - ~A" name) "")))
+ (let ((pos dy))
+ (when (equal group *current-root*)
+ (xlib:draw-image-glyphs window gc 5 (incf pos dy)
+ (format nil "~A hidden windows " (length (get-hidden-windows))))
+ (when *child-selection*
+ (xlib:draw-image-glyphs window gc 5 (incf pos dy)
+ (with-output-to-string (str)
+ (format str "Selection: ")
+ (dolist (child *child-selection*)
+ (typecase child
+ (xlib:window (format str "~A " (xlib:wm-name child)))
+ (group (format str "group:~A[~A] " (group-number child)
+ (aif (group-name child) it "")))))
+ (format str " ")))))
+ (dolist (ch child)
+ (when (xlib:window-p ch)
+ (xlib:draw-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))))))
+
+
+
+
+
+
+
+
+
+
+(defun get-father-layout (child father)
+ (if (group-p father)
+ (aif (group-layout father)
+ (funcall it child father)
+ (no-layout child father))
+ (get-fullscreen-size)))
+
+
+(defgeneric adapt-child-to-father (child father))
+
+(defmethod adapt-child-to-father ((window xlib:window) father)
+ (with-xlib-protect
+ (multiple-value-bind (nx ny nw nh raise-p)
+ (get-father-layout window father)
+ (setf (xlib:drawable-x window) nx
+ (xlib:drawable-y window) ny
+ (xlib:drawable-width window) nw
+ (xlib:drawable-height window) nh)
+ raise-p)))
+
+(defmethod adapt-child-to-father ((group group) father)
+ (with-xlib-protect
+ (multiple-value-bind (nx ny nw nh raise-p)
+ (get-father-layout group father)
+ (with-slots (rx ry rw rh window) group
+ (setf rx nx ry ny rw nw rh nh)
+ (setf (xlib:drawable-x window) rx
+ (xlib:drawable-y window) ry
+ (xlib:drawable-width window) rw
+ (xlib:drawable-height window) rh)
+ raise-p))))
+
+
+
+(defgeneric show-child (child father))
+(defgeneric hide-child (child))
+
+(defmethod show-child ((group group) father)
+ (with-xlib-protect
+ (with-slots (window) group
+ (let ((raise-p (adapt-child-to-father group father)))
+ (when (or *show-root-group-p* (not (equal group *current-root*)))
+ (setf (xlib:window-background window) (get-color "Black"))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window))
+ (display-group-info group))))))
+
+
+(defmethod hide-child ((group group))
+ (with-xlib-protect
+ (with-slots (window) group
+ (xlib:unmap-window window))))
+
+
+(defmethod show-child ((window xlib:window) father)
+ (with-xlib-protect
+ (let ((raise-p nil))
+ (when (eql (window-type window) :normal)
+ (setf raise-p (adapt-child-to-father window father)))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window)))))
+
+(defmethod hide-child ((window xlib:window))
+ (hide-window window))
+
+
+
+
+
+
+(defgeneric select-child (child selected))
+
+(defmethod select-child ((group group) selected)
+ (with-xlib-protect
+ (when (and (group-p group) (group-window group))
+ (setf (xlib:window-border (group-window group))
+ (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+ ((equal selected nil) *color-unselected*)
+ (selected *color-selected*)))))))
+
+(defmethod select-child ((window xlib:window) selected)
+ (with-xlib-protect
+ (setf (xlib:window-border window)
+ (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+ ((equal selected nil) *color-unselected*)
+ (selected *color-selected*))))))
+
+(defun select-current-group (selected)
+ (select-child *current-child* selected))
+
+
+
+(defun set-focus-to-current-child ()
+ (no-focus)
+ (when (group-p *current-child*)
+ (when (xlib:window-p (first (group-child *current-child*)))
+ (focus-window (first (group-child *current-child*)))))
+ (when (xlib:window-p *current-child*)
+ (focus-window *current-child*)))
+
+
+
+
+
+(defun show-all-childs ()
+ "Show all childs from *current-root*"
+ (labels ((rec (root father first-p)
+ (show-child root father)
+ (select-child root (if (equal root *current-child*) t
+ (if first-p :maybe nil)))
+ (when (group-p root)
+ (let ((first-child (first (group-child root))))
+ (dolist (child (reverse (group-child root)))
+ (rec child root (and first-p (equal child first-child))))))))
+ (rec *current-root* nil t)
+ (set-focus-to-current-child)))
+
+
+
+
+(defun hide-all-childs (root)
+ (hide-child root)
+ (when (group-p root)
+ (dolist (child (group-child root))
+ (hide-all-childs child))))
+
+
+
+
+(defun select-next/previous-brother (fun-rotate)
+ "Select the next/previous brother group"
+ (let ((group-is-root? (and (equal *current-root* *current-child*)
+ (not (equal *current-root* *root-group*)))))
+ (if group-is-root?
+ (hide-all-childs *current-root*)
+ (select-current-group nil))
+ (let ((father (find-father-group *current-child*)))
+ (when (group-p father)
+ (with-slots (child) father
+ (setf child (funcall fun-rotate child))
+ (setf *current-child* (first child)))))
+ (when group-is-root?
+ (setf *current-root* *current-child*))
+ (show-all-childs)))
+
+
+(defun select-next-brother ()
+ "Select the next brother group"
+ (select-next/previous-brother #'anti-rotate-list))
+
+(defun select-previous-brother ()
+ "Select the previous brother group"
+ (select-next/previous-brother #'rotate-list))
+
+
+(defun select-next-level ()
+ "Select the next level in group"
+ (select-current-group nil)
+ (when (group-p *current-child*)
+ (awhen (first (group-child *current-child*))
+ (setf *current-child* it)))
+ (show-all-childs))
+
+(defun select-previous-level ()
+ "Select the previous level in group"
+ (unless (equal *current-child* *current-root*)
+ (select-current-group nil)
+ (awhen (find-father-group *current-child*)
+ (setf *current-child* it))
+ (show-all-childs)))
+
+
+(defun select-next/previous-child (fun-rotate)
+ "Select the next/previous child"
+ (when (group-p *current-child*)
+ (with-slots (child) *current-child*
+ (setf child (funcall fun-rotate child)))
+ (show-all-childs)))
+
+
+(defun select-next-child ()
+ "Select the next child"
+ (select-next/previous-child #'anti-rotate-list))
+
+(defun select-previous-child ()
+ "Select the previous child"
+ (select-next/previous-child #'rotate-list))
+
+
+
+(defun enter-group ()
+ "Enter in the selected group - ie make it the root group"
+ (hide-all-childs *current-root*)
+ (setf *current-root* *current-child*)
+ (show-all-childs))
+
+(defun leave-group ()
+ "Leave the selected group - ie make its father the root group"
+ (hide-all-childs *current-root*)
+ (awhen (find-father-group *current-root*)
+ (when (group-p it)
+ (setf *current-root* it)))
+ (show-all-childs))
+
+
+(defun switch-to-root-group ()
+ "Switch to the root group"
+ (hide-all-childs *current-root*)
+ (setf *current-root* *root-group*)
+ (show-all-childs))
+
+(defun switch-and-select-root-group ()
+ "Switch and select the root group"
+ (hide-all-childs *current-root*)
+ (setf *current-root* *root-group*)
+ (setf *current-child* *current-root*)
+ (show-all-childs))
+
+
+(defun toggle-show-root-group ()
+ "Show/Hide the root group"
+ (hide-all-childs *current-root*)
+ (setf *show-root-group-p* (not *show-root-group-p*))
+ (show-all-childs))
+
+
+(defun focus-child (child father)
+ "Focus child - Return true if something has change"
+ (when (and (group-p father)
+ (member child (group-child father)))
+ (when (not (equal child (first (group-child father))))
+ (loop until (equal child (first (group-child father)))
+ do (setf (group-child father) (rotate-list (group-child father))))
+ t)))
+
+(defun focus-child-rec (child father)
+ "Focus child and its fathers - Return true if something has change"
+ (let ((change nil))
+ (labels ((rec (child father)
+ (when (focus-child child father)
+ (setf change t))
+ (when father
+ (rec father (find-father-group father)))))
+ (rec child father))
+ change))
+
+(defun set-current-child (child father)
+ "Set *current-child* to child - Return t if something has change"
+ (cond ((and (group-p child) (not (equal *current-child* child)))
+ (setf *current-child* child)
+ t)
+ ((and (group-p father) (not (equal *current-child* father)))
+ (setf *current-child* father)
+ t)))
+
+(defun set-current-root (father)
+ "Set current root if father is not in current root"
+ (unless (find-child father *current-root*)
+ (setf *current-root* father)))
+
+
+(defun focus-all-childs (child father)
+ "Focus child and its fathers - Set current group to father"
+ (let ((new-focus (focus-child-rec child father))
+ (new-current-child (set-current-child child father))
+ (new-root (set-current-root father)))
+ (or new-focus new-current-child new-root)))
+
+
+
+(defun remove-child-in-group (child group)
+ "Remove the child in group"
+ (when (group-p group)
+ (setf (group-child group) (remove child (group-child group) :test #'equal))))
+
+(defun remove-child-in-groups (child root)
+ "Remove child in the group root and in all its childs"
+ (with-all-groups (root group)
+ (remove-child-in-group child group))
+ (when (xlib:window-p child)
+ (netwm-remove-in-client-list child)))
+
+
+
+(defun remove-child-in-all-groups (child)
+ "Remove child in all groups from *root-group*"
+ (when (equal child *current-root*)
+ (setf *current-root* (find-father-group child)))
+ (when (equal child *current-child*)
+ (setf *current-child* *current-root*))
+ (remove-child-in-groups child *root-group*))
+
+
+
+
+
+
+(defun process-new-window (window)
+ "When a new window is created (or when we are scanning initial
+windows), this function dresses the window up and gets it ready to be
+managed."
+ ;; Listen for events
+ ;;(create-workspace-on-request)
+ ;;(create-group-on-request)
+ ;; PHIL: TODO: add a hook here
+ (with-xlib-protect
+ (setf (xlib:window-event-mask window) *window-events*)
+ (set-window-state window +normal-state+)
+ (setf (xlib:drawable-border-width window) (case (window-type window)
+ (:normal 1)
+ (:maxsize 1)
+ (:transient 1)
+ (t 0)))
+ (grab-all-buttons window)
+ (when (xlib:window-p *current-child*)
+ (leave-group)
+ (select-previous-level))
+ ;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
+ (pushnew window (group-child *current-child*)) ;)
+ (unhide-window window)
+ ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
+ (case (window-type window)
+ (:normal (adapt-child-to-father window *current-child*))
+ (t (let* ((hints (xlib:wm-normal-hints window))
+ (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
+ (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
+ (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (xlib:drawable-width *root*)))
+ (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (xlib:drawable-height *root*)))
+ (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
+ (xlib:drawable-width window)))
+ (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
+ (xlib:drawable-height window))))
+ (setf (xlib:drawable-width window) (min (max min-width rwidth) max-width)
+ (xlib:drawable-height window) (min (max min-height rheight) max-height))
+ (setf (xlib:drawable-x window) (truncate (+ (group-rx *current-child*) (/ (- (group-rw *current-child*) (xlib:drawable-width window)) 2)))
+ (xlib:drawable-y window) (truncate (+ (group-ry *current-child*) (/ (- (group-rh *current-child*) (xlib:drawable-height window)) 2)))))))
+ (netwm-add-in-client-list window)))
+
+
+
+
+;;(defun hide-existing-windows (screen)
+;; "Hide all existing windows in screen"
+;; (dolist (win (xlib:query-tree (xlib:screen-root screen)))
+;; (hide-window win)))
+
+(defun process-existing-windows (screen)
+ "Windows present when clfswm starts up must be absorbed by clfswm."
+ (let ((id-list nil)
+ (all-windows (get-all-windows)))
+ (dolist (win (xlib:query-tree (xlib:screen-root screen)))
+ (unless (member win all-windows)
+ (let ((map-state (xlib:window-map-state win))
+ (wm-state (window-state win)))
+ (unless (or (eql (xlib:window-override-redirect win) :on)
+ (eql win *no-focus-window*))
+ (when (or (eql map-state :viewable)
+ (eql wm-state +iconic-state+))
+ (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
+ ;; (unhide-window win)
+ (process-new-window win)
+ (xlib:map-window win)
+ (pushnew (xlib:window-id win) id-list))))))
+ (netwm-set-client-list id-list)))
Added: clfswm/clfswm-keys.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-keys.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,276 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 12 19:23:14 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Keys functions definition
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defun define-hash-table-key-name (hash-table name)
+ (setf (gethash 'name hash-table) name))
+
+;;; CONFIG - Key mode names
+
+(define-hash-table-key-name *main-keys* "Main mode keys")
+(define-hash-table-key-name *second-keys* "Second mode keys")
+(define-hash-table-key-name *mouse-action* "Mouse buttons actions in second mode")
+(define-hash-table-key-name *pager-keys* "Pager mode keys")
+(define-hash-table-key-name *pager-mouse-action* "Mouse buttons actions in pager mode")
+(define-hash-table-key-name *info-keys* "Info mode keys")
+(define-hash-table-key-name *info-mouse-action* "Mouse buttons actions in info mode")
+
+
+(defmacro define-define-key (name hashtable)
+ (let ((name-key-fun (create-symbol "define-" name "-key-fun"))
+ (name-key (create-symbol "define-" name "-key"))
+ (undefine-name (create-symbol "undefine-" name "-key"))
+ (undefine-multi-name (create-symbol "undefine-" name "-multi-keys")))
+ `(progn
+ (defun ,name-key-fun (key function &optional keystring)
+ "Define a new key, a key is '(char '(modifier list))"
+ (setf (gethash key ,hashtable) (list function keystring)))
+
+ (defmacro ,name-key ((key &rest modifiers) function &optional keystring)
+ `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function ,keystring))
+
+ (defmacro ,undefine-name ((key &rest modifiers))
+ `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
+
+ (defmacro ,undefine-multi-name (&rest keys)
+ `(progn
+ ,@(loop for k in keys
+ collect `(,',undefine-name ,k)))))))
+
+
+(defmacro define-define-mouse (name hashtable)
+ (let ((name-mouse-fun (create-symbol "define-" name "-fun"))
+ (name-mouse (create-symbol "define-" name))
+ (undefine-name (create-symbol "undefine-" name)))
+ `(progn
+ (defun ,name-mouse-fun (button function-press &optional keystring function-release)
+ "Define a new mouse button action, a button is '(button number '(modifier list))"
+ (setf (gethash button ,hashtable) (list function-press keystring function-release)))
+
+ (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release keystring)
+ `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,keystring ,function-release))
+
+ (defmacro ,undefine-name ((key &rest modifiers))
+ `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
+
+
+
+(define-define-key "main" *main-keys*)
+(define-define-key "second" *second-keys*)
+(define-define-key "pager" *pager-keys*)
+(define-define-key "info" *info-keys*)
+
+
+
+
+;;(defun undefine-main-keys (&rest keys)
+;; (dolist (k keys)
+;; (undefine-main-key k)))
+
+(defun undefine-info-key-fun (key)
+ (remhash key *info-keys*))
+
+(define-define-mouse "mouse-action" *mouse-action*)
+(define-define-mouse "pager-mouse-action" *pager-mouse-action*)
+(define-define-mouse "info-mouse-action" *info-mouse-action*)
+
+
+
+
+
+(defmacro define-ungrab/grab (name function hashtable)
+ `(defun ,name ()
+ (maphash #'(lambda (k v)
+ (declare (ignore v))
+ (when (consp k)
+ (handler-case
+ (let* ((key (first k))
+ (keycode (typecase key
+ (character (char->keycode key))
+ (number key)
+ (string (let ((keysym (keysym-name->keysym key)))
+ (and keysym (xlib:keysym->keycodes *display* keysym)))))))
+ (if keycode
+ (,function *root* keycode :modifiers (second k))
+ (format t "~&Grabbing error: Can't find key '~A'~%" key)))
+ (error (c)
+ ;;(declare (ignore c))
+ (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
+ (force-output)))
+ ,hashtable)))
+
+(define-ungrab/grab grab-main-keys xlib:grab-key *main-keys*)
+(define-ungrab/grab ungrab-main-keys xlib:ungrab-key *main-keys*)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defun funcall-key-from-code (hash-table-key code state &optional args)
+ (labels ((funcall-from (key)
+ (multiple-value-bind (function foundp)
+ (gethash (list key state) hash-table-key)
+ (when (and foundp (first function))
+ (if args
+ (funcall (first function) args)
+ (funcall (first function)))
+ t)))
+ (from-code ()
+ (funcall-from code))
+ (from-char ()
+ (let ((char (keycode->char code state)))
+ (funcall-from char)))
+ (from-string ()
+ (let ((string (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+ (funcall-from string))))
+ (cond ((from-code))
+ ((from-char))
+ ((from-string)))))
+
+
+
+(defun funcall-button-from-code (hash-table-key code state root-x root-y
+ &optional (action #'first) args)
+ "Action: first=press third=release"
+ (let ((state (modifiers->state (set-difference (state->modifiers state)
+ '(:button-1 :button-2 :button-3 :button-4 :button-5)))))
+ (multiple-value-bind (function foundp)
+ (gethash (list code state) hash-table-key)
+ (if (and foundp (funcall action function))
+ (if args
+ (funcall (funcall action function) root-x root-y args)
+ (funcall (funcall action function) root-x root-y))
+ t))))
+
+
+
+
+;;;,-----
+;;;| Auto documentation tools
+;;;`-----
+
+(defun produce-doc-html (hash-table-key-list &optional (stream t))
+ "Produce an html doc from a hash-table key"
+ (labels ((clean-string (str)
+ (cond ((string-equal str "#\\:") ":")
+ ((string-equal str "#\\#") "#")
+ ((string-equal str "#\\\\") "\\")
+ (t (substitute #\Space #\#
+ (substitute #\Space #\\
+ (substitute #\Space #\: str))))))
+ (produce-keys (hk)
+ `("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
+ (tr ("th align=\"right\" width=\"10%\"" "Modifiers")
+ ("th align=\"center\" width=\"10%\"" "Key/Button")
+ ("th align=\"left\"" "Function"))
+ ,@(let ((acc nil))
+ (maphash #'(lambda (k v)
+ (when (consp k)
+ (push `(tr
+ ("td align=\"right\" style=\"color:#FF0000\" nowrap"
+ ,(clean-string (format nil "~{~@(~S ~)~}" (state->modifiers (second k)))))
+ ("td align=\"center\" nowrap"
+ ,(clean-string (format nil "~@(~S~)"
+ (or (second v)
+ (and (stringp (first k))
+ (intern (string-upcase (first k))))
+ (first k)))))
+ ("td style=\"color:#0000FF\" nowrap" ,(documentation (or (first v) (third v)) 'function)))
+ acc)))
+ hk)
+ (nreverse acc)))))
+ (produce-html
+ `(html
+ (head
+ (title "CLFSWM Keys"))
+ (body
+ (h1 "CLFSWM Keys")
+ (p (small "Note: Mod-1 is the Meta or Alt key"))
+ ,@(let ((acc nil))
+ (dolist (hk hash-table-key-list)
+ (push `(h3 (u ,(gethash 'name hk))) acc)
+ (push (produce-keys hk) acc))
+ (nreverse acc))))
+ 0 stream)))
+
+
+(defun produce-doc-html-in-file (filename)
+ (with-open-file (stream filename :direction :output
+ :if-exists :supersede :if-does-not-exist :create)
+ (produce-doc-html (list *main-keys* *second-keys* *mouse-action* *pager-keys* *pager-mouse-action*
+ *info-keys* *info-mouse-action*)
+ stream)))
+
+
+
+(defun produce-doc (hash-table-key-list &optional (stream t))
+ "Produce a text doc from a hash-table key"
+ (format stream " * CLFSWM Keys *~%")
+ (format stream " -----------~%")
+ (format stream "~%Note: Mod-1 is the Meta or Alt key~%")
+ (dolist (hk hash-table-key-list)
+ (format stream "~2&~A:~%" (gethash 'name hk))
+ (dotimes (i (length (gethash 'name hk)))
+ (format stream "-"))
+ (format stream "~2%")
+ (maphash #'(lambda (k v)
+ (when (consp k)
+ (format stream "~&~20@<~{~@(~A~) ~}~> ~13@<~@(~A~)~> ~A~%"
+ (state->modifiers (second k))
+ (remove #\# (remove #\\ (format nil "~S" (or (second v)
+ (and (stringp (first k))
+ (intern (string-upcase (first k))))
+ (first k)))))
+ (documentation (or (first v) (third v)) 'function))))
+ hk)
+ (format stream "~2&")))
+
+
+
+(defun produce-doc-in-file (filename)
+ (with-open-file (stream filename :direction :output
+ :if-exists :supersede :if-does-not-exist :create)
+ (produce-doc (list *main-keys* *second-keys* *mouse-action* *pager-keys* *pager-mouse-action*
+ *info-keys* *info-mouse-action*)
+ stream)))
+
+
+(defun produce-all-docs ()
+ "Produce all docs in keys.html and keys.txt"
+ (produce-doc-in-file "keys.txt")
+ (produce-doc-html-in-file "keys.html"))
+
Added: clfswm/clfswm-layout.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-layout.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,284 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Wed Feb 27 22:19:57 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Layout functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+;;; CONFIG - Layout menu
+;;;
+;;; To add a new layout:
+;;; 1- define your own layout: a method returning the real size of the
+;;; child in screen size (integer) as 5 values (rx, ry, rw, rh, raise-p).
+;;; This method can use the float size of the child (x, y ,w , h).
+;;; It can be specialised for xlib:window or group
+;;; 2- Define a seter function for your layout
+;;; 3- Register your new layout with register-layout.
+
+
+
+
+;;; Generic functions
+(defun set-layout (layout)
+ "Set the layout of the current child"
+ (when (group-p *current-child*)
+ (setf (group-layout *current-child*) layout)
+ (leave-second-mode)))
+ ;;(show-all-childs)))
+
+(defun get-managed-child (father)
+ "Return only window in normal mode who can be tiled"
+ (when (group-p father)
+ (remove-if #'(lambda (x)
+ (and (xlib:window-p x) (not (eql (window-type x) :normal))))
+ (group-child father))))
+
+(defun register-layout (layout)
+ (setf *layout-list* (append *layout-list* (list layout))))
+
+
+
+;;; No layout
+(defgeneric no-layout (child father)
+ (:documentation "Maximize windows in there group - leave group to there size"))
+
+(defmethod no-layout ((child xlib:window) father)
+ (with-slots (rx ry rw rh) father
+ (values (1+ rx) (1+ ry) (- rw 2) (- rh 2) nil)))
+
+(defmethod no-layout ((child group) father)
+ (with-slots ((cx x) (cy y) (cw w) (ch h)) child
+ (with-slots ((frx rx) (fry ry) (frw rw) (frh rh)) father
+ (values (round (+ (* cx frw) frx))
+ (round (+ (* cy frh) fry))
+ (round (* cw frw))
+ (round (* ch frh))
+ t))))
+
+(defun set-no-layout ()
+ "Maximize windows in there group - leave group to there size"
+ (set-layout #'no-layout))
+
+(register-layout 'set-no-layout)
+
+
+
+
+;;; Tile layout
+(defgeneric tile-layout (child father)
+ (:documentation "Tile child in its group"))
+
+(defmethod tile-layout (child father)
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (length managed-childs))
+ (n (ceiling (sqrt len)))
+ (dx (/ (group-rw father) n))
+ (dy (/ (group-rh father) (ceiling (/ len n)))))
+ (values (round (+ (group-rx father) (truncate (* (mod pos n) dx)) 1))
+ (round (+ (group-ry father) (truncate (* (truncate (/ pos n)) dy)) 1))
+ (round (- dx 2))
+ (round (- dy 2))
+ nil)))
+
+(defun set-tile-layout ()
+ "Tile child in its group"
+ (set-layout #'tile-layout))
+
+(register-layout 'set-tile-layout)
+
+
+;;; Tile Left
+(defun layout-ask-size (msg slot &optional (min 80))
+ (when (group-p *current-child*)
+ (let ((new-size (/ (or (query-number msg) min) 100)))
+ (when (<= 0 new-size 1)
+ (setf (group-data-slot *current-child* slot) new-size)))))
+
+
+
+
+(defgeneric tile-left-layout (child father)
+ (:documentation "Tile Left: main child on left and others on right"))
+
+(defmethod tile-left-layout (child father)
+ (with-slots (rx ry rw rh) father
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (max (1- (length managed-childs)) 1))
+ (dy (/ rh len))
+ (size (or (group-data-slot father :tile-size) 0.8)))
+ (if (= pos 0)
+ (values (1+ rx)
+ (1+ ry)
+ (- (round (* rw size)) 2)
+ (- rh 2)
+ nil)
+ (values (1+ (round (+ rx (* rw size))))
+ (1+ (round (+ ry (* dy (1- pos)))))
+ (- (round (* rw (- 1 size))) 2)
+ (- (round dy) 2)
+ nil)))))
+
+
+(defun set-tile-left-layout ()
+ "Tile Left: main child on left and others on right"
+ (layout-ask-size "Tile size in percent (%)" :tile-size)
+ (set-layout #'tile-left-layout))
+
+(register-layout 'set-tile-left-layout)
+
+
+
+;;; Tile right
+(defgeneric tile-right-layout (child father)
+ (:documentation "Tile Right: main child on right and others on left"))
+
+(defmethod tile-right-layout (child father)
+ (with-slots (rx ry rw rh) father
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (max (1- (length managed-childs)) 1))
+ (dy (/ rh len))
+ (size (or (group-data-slot father :tile-size) 0.8)))
+ (if (= pos 0)
+ (values (1+ (round (+ rx (* rw (- 1 size)))))
+ (1+ ry)
+ (- (round (* rw size)) 2)
+ (- rh 2)
+ nil)
+ (values (1+ rx)
+ (1+ (round (+ ry (* dy (1- pos)))))
+ (- (round (* rw (- 1 size))) 2)
+ (- (round dy) 2)
+ nil)))))
+
+
+(defun set-tile-right-layout ()
+ "Tile Right: main child on right and others on left"
+ (layout-ask-size "Tile size in percent (%)" :tile-size)
+ (set-layout #'tile-right-layout))
+
+
+(register-layout 'set-tile-right-layout)
+
+
+
+
+;;; Tile Top
+(defgeneric tile-top-layout (child father)
+ (:documentation "Tile Top: main child on top and others on bottom"))
+
+(defmethod tile-top-layout (child father)
+ (with-slots (rx ry rw rh) father
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (max (1- (length managed-childs)) 1))
+ (dx (/ rw len))
+ (size (or (group-data-slot father :tile-size) 0.8)))
+ (if (= pos 0)
+ (values (1+ rx)
+ (1+ ry)
+ (- rw 2)
+ (- (round (* rh size)) 2)
+ nil)
+ (values (1+ (round (+ rx (* dx (1- pos)))))
+ (1+ (round (+ ry (* rh size))))
+ (- (round dx) 2)
+ (- (round (* rh (- 1 size))) 2)
+ nil)))))
+
+
+(defun set-tile-top-layout ()
+ "Tile Top: main child on top and others on bottom"
+ (layout-ask-size "Tile size in percent (%)" :tile-size)
+ (set-layout #'tile-top-layout))
+
+(register-layout 'set-tile-top-layout)
+
+
+
+;;; Tile Bottom
+(defgeneric tile-bottom-layout (child father)
+ (:documentation "Tile Bottom: main child on bottom and others on top"))
+
+(defmethod tile-bottom-layout (child father)
+ (with-slots (rx ry rw rh) father
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (max (1- (length managed-childs)) 1))
+ (dx (/ rw len))
+ (size (or (group-data-slot father :tile-size) 0.8)))
+ (if (= pos 0)
+ (values (1+ rx)
+ (1+ (round (+ ry (* rh (- 1 size)))))
+ (- rw 2)
+ (- (round (* rh size)) 2))
+ (values (1+ (round (+ rx (* dx (1- pos)))))
+ (1+ ry)
+ (- (round dx) 2)
+ (- (round (* rh (- 1 size))) 2))))))
+
+
+
+(defun set-tile-bottom-layout ()
+ "Tile Bottom: main child on bottom and others on top"
+ (layout-ask-size "Tile size in percent (%)" :tile-size)
+ (set-layout #'tile-bottom-layout))
+
+
+(register-layout 'set-tile-bottom-layout)
+
+
+
+
+
+;;; Space layout
+(defgeneric tile-space-layout (child father)
+ (:documentation "Tile Space: tile child in its group leaving spaces between them"))
+
+(defmethod tile-space-layout (child father)
+ (with-slots (rx ry rw rh) father
+ (let* ((managed-childs (get-managed-child father))
+ (pos (position child managed-childs))
+ (len (length managed-childs))
+ (n (ceiling (sqrt len)))
+ (dx (/ rw n))
+ (dy (/ rh (ceiling (/ len n))))
+ (size (or (group-data-slot father :tile-space-size) 0.1)))
+ (when (> size 0.5) (setf size 0.45))
+ (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
+ (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
+ (round (- dx (* dx size 2) 2))
+ (round (- dy (* dy size 2) 2))
+ nil))))
+
+(defun set-space-tile-layout ()
+ "Tile Space: tile child in its group leaving spaces between them"
+ (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
+ (set-layout #'tile-space-layout))
+
+(register-layout 'set-space-tile-layout)
Added: clfswm/clfswm-pack.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-pack.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,479 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 12 14:02:45 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Tile, pack and fill functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+;;;,-----
+;;;| Tile functions
+;;;`-----
+(defun tile-workspace-vertically (workspace)
+ "Tile a workspace vertically"
+ (let* ((len (max (length (workspace-group-list workspace)) 1))
+ (n (ceiling (sqrt len)))
+ (dx (/ (xlib:screen-width *screen*) n))
+ (dy (/ (xlib:screen-height *screen*) (ceiling (/ len n)))))
+ (loop for group in (workspace-group-list workspace)
+ for i from 0 do
+ (setf (group-x group) (1+ (truncate (* (mod i n) dx)))
+ (group-y group) (1+ (truncate (* (truncate (/ i n)) dy)))
+ (group-width group) (- (truncate dx) 2)
+ (group-height group) (- (truncate dy) 2)))))
+
+
+(defun tile-current-workspace-vertically ()
+ "Tile the current workspace vertically"
+ (minimize-group (current-group))
+ (tile-workspace-vertically (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+
+(defun tile-workspace-horizontally (workspace)
+ "Tile a workspace horizontally"
+ (let* ((len (max (length (workspace-group-list workspace)) 1))
+ (n (ceiling (sqrt len)))
+ (dx (/ (xlib:screen-width *screen*) (ceiling (/ len n))))
+ (dy (/ (xlib:screen-height *screen*) n)))
+ (loop for group in (workspace-group-list workspace)
+ for i from 0 do
+ (setf (group-x group) (1+ (truncate (* (truncate (/ i n)) dx)))
+ (group-y group) (1+ (truncate (* (mod i n) dy)))
+ (group-width group) (- (truncate dx) 2)
+ (group-height group) (- (truncate dy) 2)))))
+
+
+(defun tile-current-workspace-horizontally ()
+ "Tile the current workspace horizontally"
+ (minimize-group (current-group))
+ (tile-workspace-horizontally (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun tile-workspace-right (workspace)
+ "Tile workspace with the current window on the left and others on the right"
+ (let ((len (length (workspace-group-list workspace)))
+ (group (first (workspace-group-list workspace))))
+ (if (<= len 1)
+ (setf (group-x group) 0
+ (group-y group) 0
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dy (/ (xlib:screen-height *screen*) (1- len))))
+ (setf (group-x group) 1
+ (group-y group) 1
+ (group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+ (group-height group) (- (xlib:screen-height *screen*) 1))
+ (loop :for i :from 0
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (- (xlib:screen-width *screen*) *tile-border-size* -1)
+ (group-y g) (truncate (* i dy))
+ (group-width g) (- *tile-border-size* 2)
+ (group-height g) (truncate (- dy 1))))))))
+
+(defun tile-workspace-left (workspace)
+ "Tile workspace with the current window on the right and others on the left"
+ (let ((len (length (workspace-group-list workspace)))
+ (group (first (workspace-group-list workspace))))
+ (if (<= len 1)
+ (setf (group-x group) 0
+ (group-y group) 0
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dy (/ (xlib:screen-height *screen*) (1- len))))
+ (setf (group-x group) *tile-border-size*
+ (group-y group) 1
+ (group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+ (group-height group) (- (xlib:screen-height *screen*) 1))
+ (loop :for i :from 0
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) 0
+ (group-y g) (truncate (* i dy))
+ (group-width g) (- *tile-border-size* 2)
+ (group-height g) (truncate (- dy 1))))))))
+
+
+(defun tile-workspace-top (workspace)
+ "Tile workspace with the current window on the bottom and others on the top"
+ (let ((len (length (workspace-group-list workspace)))
+ (group (first (workspace-group-list workspace))))
+ (if (<= len 1)
+ (setf (group-x group) 0
+ (group-y group) 0
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dx (/ (xlib:screen-width *screen*) (1- len))))
+ (setf (group-x group) 1
+ (group-y group) *tile-border-size*
+ (group-width group) (- (xlib:screen-width *screen*) 1)
+ (group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
+ (loop :for i :from 0
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (truncate (* i dx))
+ (group-y g) 0
+ (group-width g) (truncate (- dx 1))
+ (group-height g) (- *tile-border-size* 2)))))))
+
+(defun tile-workspace-bottom (workspace)
+ "Tile workspace with the current window on the top and others on the bottom"
+ (let ((len (length (workspace-group-list workspace)))
+ (group (first (workspace-group-list workspace))))
+ (if (<= len 1)
+ (setf (group-x group) 0
+ (group-y group) 0
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dx (/ (xlib:screen-width *screen*) (1- len))))
+ (setf (group-x group) 1
+ (group-y group) 1
+ (group-width group) (- (xlib:screen-width *screen*) 1)
+ (group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
+ (loop :for i :from 0
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (truncate (* i dx))
+ (group-y g) (- (xlib:screen-height *screen*) *tile-border-size* -1)
+ (group-width g) (truncate (- dx 1))
+ (group-height g) (- *tile-border-size* 2)))))))
+
+
+(defun tile-current-workspace-to ()
+ "Tile the current workspace with the current window on one side and others on the other"
+ (funcall *tile-workspace-function* (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun reconfigure-tile-workspace ()
+ "Reconfigure the workspace tiling for the current session"
+ (let ((method (loop :for m = (intern (string-upcase
+ (query-string "Workspace tiling method (R)ight, (L)eft, (T)op, (B)ottom:"))
+ :keyword)
+ :when (member m '(:r :l :t :b)) :return m))
+ (size (loop :for s = (parse-integer (query-string "Workspace tiling border size"
+ (format nil "~A" *tile-border-size*))
+ :junk-allowed t)
+ :when (numberp s) :return s)))
+ (setf *tile-workspace-function* (case method
+ (:r 'tile-workspace-right)
+ (:l 'tile-workspace-left)
+ (:t 'tile-workspace-top)
+ (:b 'tile-workspace-bottom))
+ *tile-border-size* size)))
+
+
+
+
+;;;,-----
+;;;| Edges functions
+;;;`-----
+(defun group-x2 (group)
+ (+ (group-x group) (group-width group)))
+
+(defun group-y2 (group)
+ (+ (group-y group) (group-height group)))
+
+
+(defun find-edge-up (current-group workspace)
+ (let ((y-found 0))
+ (dolist (group (workspace-group-list workspace))
+ (when (and (not (equal group current-group))
+ (<= (group-y2 group) (group-y current-group))
+ (>= (group-x2 group) (group-x current-group))
+ (<= (group-x group) (group-x2 current-group)))
+ (setf y-found (max y-found (+ (group-y2 group) 2)))))
+ y-found))
+
+(defun find-edge-down (current-group workspace)
+ (let ((y-found (xlib:screen-height *screen*)))
+ (dolist (group (workspace-group-list workspace))
+ (when (and (not (equal group current-group))
+ (>= (group-y group) (group-y2 current-group))
+ (>= (group-x2 group) (group-x current-group))
+ (<= (group-x group) (group-x2 current-group)))
+ (setf y-found (min y-found (- (group-y group) 2)))))
+ y-found))
+
+(defun find-edge-right (current-group workspace)
+ (let ((x-found (xlib:screen-width *screen*)))
+ (dolist (group (workspace-group-list workspace))
+ (when (and (not (equal group current-group))
+ (>= (group-x group) (group-x2 current-group))
+ (>= (group-y2 group) (group-y current-group))
+ (<= (group-y group) (group-y2 current-group)))
+ (setf x-found (min x-found (- (group-x group) 2)))))
+ x-found))
+
+
+(defun find-edge-left (current-group workspace)
+ (let ((x-found 0))
+ (dolist (group (workspace-group-list workspace))
+ (when (and (not (equal group current-group))
+ (<= (group-x2 group) (group-x current-group))
+ (>= (group-y2 group) (group-y current-group))
+ (<= (group-y group) (group-y2 current-group)))
+ (setf x-found (max x-found (+ (group-x2 group) 2)))))
+ x-found))
+
+
+
+;;;,-----
+;;;| Pack functions
+;;;`-----
+
+
+
+(defun pack-group-up (workspace group)
+ "Pack group to up"
+ (let ((y-found (find-edge-up group workspace)))
+ (setf (group-y group) y-found)))
+
+
+(defun pack-group-down (workspace group)
+ "Pack group to down"
+ (let ((y-found (find-edge-down group workspace)))
+ (setf (group-y group) (- y-found (group-height group)))))
+
+(defun pack-group-right (workspace group)
+ "Pack group to right"
+ (let ((x-found (find-edge-right group workspace)))
+ (setf (group-x group) (- x-found (group-width group)))))
+
+
+(defun pack-group-left (workspace group)
+ "Pack group to left"
+ (let ((x-found (find-edge-left group workspace)))
+ (setf (group-x group) x-found)))
+
+
+
+
+(defun pack-current-group-up ()
+ "Pack current group to up"
+ (pack-group-up (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun pack-current-group-down ()
+ "Pack current group to down"
+ (pack-group-down (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun pack-current-group-right ()
+ "Pack current group to right"
+ (pack-group-right (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun pack-current-group-left ()
+ "Pack current group to left"
+ (pack-group-left (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun center-group (group)
+ "Center group"
+ (setf (group-x group) (truncate (/ (- (xlib:screen-width *screen*) (group-width group)) 2))
+ (group-y group) (truncate (/ (- (xlib:screen-height *screen*) (group-height group)) 2))))
+
+(defun center-current-group ()
+ "Center the current group"
+ (center-group (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+;;;,-----
+;;;| Fill functions
+;;;`-----
+
+
+(defun fill-group-up (workspace group)
+ "Fill a group up"
+ (let* ((y-found (find-edge-up group workspace))
+ (dy (- (group-y group) y-found)))
+ (setf (group-y group) y-found
+ (group-height group) (+ (group-height group) dy))))
+
+(defun fill-group-down (workspace group)
+ "Fill a group down"
+ (let* ((y-found (find-edge-down group workspace))
+ (dy (- y-found (group-y2 group))))
+ (setf (group-height group) (+ (group-height group) dy))))
+
+
+(defun fill-group-left (workspace group)
+ "Fill a group left"
+ (let* ((x-found (find-edge-left group workspace))
+ (dx (- (group-x group) x-found)))
+ (setf (group-x group) x-found
+ (group-width group) (+ (group-width group) dx))))
+
+(defun fill-group-right (workspace group)
+ "Fill a group rigth"
+ (let* ((x-found (find-edge-right group workspace))
+ (dx (- x-found (group-x2 group))))
+ (setf (group-width group) (+ (group-width group) dx))))
+
+
+(defun fill-current-group-up ()
+ "Fill the current group up"
+ (fill-group-up (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun fill-current-group-down ()
+ "Fill the current group down"
+ (fill-group-down (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun fill-current-group-left ()
+ "Fill the current group left"
+ (fill-group-left (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun fill-current-group-right ()
+ "Fill the current group rigth"
+ (fill-group-right (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+
+;;;,-----
+;;;| Lower functions
+;;;`-----
+
+(defun resize-down-group (group)
+ "Resize down a group"
+ (when (> (group-width group) 100)
+ (setf (group-x group) (+ (group-x group) 10)
+ (group-width group) (max (- (group-width group) 20))))
+ (when (> (group-height group) 100)
+ (setf (group-y group) (+ (group-y group) 10)
+ (group-height group) (max (- (group-height group) 20)))))
+
+
+(defun resize-minimal-group (group)
+ "Resize down a group to its minimal size"
+ (loop while (> (group-width group) 100) do
+ (setf (group-x group) (+ (group-x group) 10)
+ (group-width group) (max (- (group-width group) 20))))
+ (loop while (> (group-height group) 100) do
+ (setf (group-y group) (+ (group-y group) 10)
+ (group-height group) (max (- (group-height group) 20)))))
+
+
+
+(defun resize-down-current-group ()
+ "Resize down the current group"
+ (resize-down-group (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun resize-minimal-current-group ()
+ "Resize down the current group to its minimal size"
+ (resize-minimal-group (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+
+
+(defun resize-half-width-left (group)
+ (setf (group-width group)
+ (max (truncate (/ (group-width group) 2))
+ 100)))
+
+(defun resize-half-width-right (group)
+ (let* ((new-size (max (truncate (/ (group-width group) 2)) 100))
+ (dx (- (group-width group) new-size)))
+ (setf (group-width group) new-size)
+ (incf (group-x group) (max dx 0))))
+
+
+(defun resize-half-height-up (group)
+ (setf (group-height group)
+ (max (truncate (/ (group-height group) 2))
+ 100)))
+
+(defun resize-half-height-down (group)
+ (let* ((new-size (max (truncate (/ (group-height group) 2)) 100))
+ (dy (- (group-height group) new-size)))
+ (setf (group-height group) new-size)
+ (incf (group-y group) (max dy 0))))
+
+
+
+
+(defun resize-half-width-left-current-group ()
+ "Resize the current group to its half width to left"
+ (resize-half-width-left (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun resize-half-width-right-current-group ()
+ "Resize the current group to its half width to right"
+ (resize-half-width-right (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun resize-half-height-up-current-group ()
+ "Resize the current group to its half height to up"
+ (resize-half-height-up (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun resize-half-height-down-current-group ()
+ "Resize the current group to its half height to down"
+ (resize-half-height-down (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+
+;;;,-----
+;;;| Explode/Implode functions
+;;;`-----
+(defun explode-group (workspace group)
+ "Create a new group for each window in group"
+ (dolist (w (rest (group-window-list group)))
+ (add-group-in-workspace (copy-group *default-group*) workspace)
+ (add-window-in-group w (first (workspace-group-list workspace)))
+ (remove-window-in-group w group)))
+
+(defun implode-group (workspace)
+ "Move all windows in workspace to one group and remove other groups"
+ (dolist (g (rest (workspace-group-list workspace)))
+ (dolist (w (group-window-list g))
+ (add-window-in-group w (first (workspace-group-list workspace)))
+ (remove-window-in-group w g))
+ (remove-group-in-workspace g workspace)))
+
+
+
+(defun explode-current-group ()
+ "Create a new group for each window in the current group"
+ (explode-group (current-workspace) (current-group))
+ (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun implode-current-group ()
+ "Move all windows in the current workspace to one group and remove other groups"
+ (implode-group (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
Added: clfswm/clfswm-second-mode.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-second-mode.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,222 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Fri Feb 22 21:38:53 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Second mode functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defparameter *sm-window* nil)
+(defparameter *sm-font* nil)
+(defparameter *sm-gc* nil)
+
+(defparameter *second-mode-program* nil
+ "Execute the program string if not nil")
+
+
+;;(defun draw-second-mode-window ()
+;; (xlib:clear-area *sm-window*)
+;; (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A"
+;; (workspace-number (current-workspace))
+;; (if *arrow-action* *arrow-action* "")
+;; (if *motion-action* *motion-action* "")
+;; (cond ((numberp *open-next-window-in-new-workspace*)
+;; (format nil ">W:~A" *open-next-window-in-new-workspace*))
+;; (*open-next-window-in-new-workspace* ">W")
+;; (t ""))
+;; (cond ((equal *open-next-window-in-new-group* :once) ">G")
+;; (*open-next-window-in-new-group* ">G+")
+;; (t ""))))
+;; (len (length text)))
+;; (xlib:draw-image-glyphs *sm-window* *sm-gc*
+;; (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+;; (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2))
+;; text)))
+
+
+(defun draw-second-mode-window ()
+ (xlib:clear-area *sm-window*)
+ (let* ((text (format nil "Second mode"))
+ (len (length text)))
+ (xlib:draw-image-glyphs *sm-window* *sm-gc*
+ (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+ (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
+ text)))
+
+
+
+
+;;; Second mode hooks
+(defun sm-handle-key-press (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (funcall-key-from-code *second-keys* code state)
+ (draw-second-mode-window))
+
+(defun sm-handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots root-x root-y))
+ ;; (focus-group-under-mouse root-x root-y)
+ (draw-second-mode-window))
+
+(defun sm-handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (compress-motion-notify)
+ (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)))
+
+(defun sm-handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *mouse-action* code state root-x root-y #'first)
+ (draw-second-mode-window))
+
+(defun sm-handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *mouse-action* code state root-x root-y #'third)
+ (draw-second-mode-window))
+
+(defun sm-handle-configure-request (&rest event-slots)
+ (apply #'handle-configure-request event-slots)
+ (draw-second-mode-window))
+
+
+(defun sm-handle-configure-notify (&rest event-slots)
+ (apply #'handle-configure-notify event-slots)
+ (draw-second-mode-window))
+
+
+(defun sm-handle-destroy-notify (&rest event-slots)
+ (apply #'handle-destroy-notify event-slots)
+ (draw-second-mode-window))
+
+(defun sm-handle-map-request (&rest event-slots)
+ (apply #'handle-map-request event-slots)
+ (draw-second-mode-window))
+
+(defun sm-handle-unmap-notify (&rest event-slots)
+ (apply #'handle-unmap-notify event-slots)
+ (draw-second-mode-window))
+
+(defun sm-handle-exposure (&rest event-slots)
+ (apply #'handle-exposure event-slots)
+ (draw-second-mode-window))
+
+
+
+;;(defun sm-handle-property-notify (&rest event-slots &key window &allow-other-keys)
+;; ;;(dbg (xlib:wm-name window))
+;; (draw-second-mode-window))
+
+
+;;; CONFIG: Second mode hooks
+(setf *sm-button-press-hook* #'sm-handle-button-press
+ *sm-button-release-hook* #'sm-handle-button-release
+ *sm-motion-notify-hook* #'sm-handle-motion-notify
+ *sm-key-press-hook* #'sm-handle-key-press
+ *sm-configure-request-hook* #'sm-handle-configure-request
+ *sm-configure-notify-hook* #'sm-handle-configure-notify
+ *sm-destroy-notify-hook* #'sm-handle-destroy-notify
+ *sm-enter-notify-hook* #'sm-handle-enter-notify
+ *sm-exposure-hook* #'sm-handle-exposure
+ *sm-map-request-hook* #'sm-handle-map-request
+ *sm-unmap-notify-hook* #'sm-handle-unmap-notify)
+
+
+
+
+
+(defun sm-handle-event (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ ;;(dbg event-key)
+ (with-xlib-protect
+ (case event-key
+ (:button-press (call-hook *sm-button-press-hook* event-slots))
+ (:button-release (call-hook *sm-button-release-hook* event-slots))
+ (:motion-notify (call-hook *sm-motion-notify-hook* event-slots))
+ (:key-press (call-hook *sm-key-press-hook* event-slots))
+ (:configure-request (call-hook *sm-configure-request-hook* event-slots))
+ (:configure-notify (call-hook *sm-configure-notify-hook* event-slots))
+ (:map-request (call-hook *sm-map-request-hook* event-slots))
+ (:unmap-notify (call-hook *sm-unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *sm-destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *sm-mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *sm-property-notify-hook* event-slots))
+ (:create-notify (call-hook *sm-create-notify-hook* event-slots))
+ (:enter-notify (call-hook *sm-enter-notify-hook* event-slots))
+ (:exposure (call-hook *sm-exposure-hook* event-slots))))
+ ;;(dbg "Ignore handle event" c event-slots)))
+ t)
+
+
+
+(defun second-key-mode ()
+ "Switch to editing mode"
+ ;;(dbg "Second key ignore" c)))))
+ (setf *sm-window* (xlib:create-window :parent *root*
+ :x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
+ :y 0
+ :width *sm-width* :height *sm-height*
+ :background (get-color *sm-background-color*)
+ :border-width 1
+ :border (get-color *sm-border-color*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure))
+ *sm-font* (xlib:open-font *display* *sm-font-string*)
+ *sm-gc* (xlib:create-gcontext :drawable *sm-window*
+ :foreground (get-color *sm-foreground-color*)
+ :background (get-color *sm-background-color*)
+ :font *sm-font*
+ :line-style :solid))
+ (xlib:map-window *sm-window*)
+ (draw-second-mode-window)
+ (no-focus)
+ (ungrab-main-keys)
+ (xgrab-keyboard *root*)
+ (xgrab-pointer *root* 66 67)
+ (unwind-protect
+ (catch 'exit-second-loop
+ (loop
+ (raise-window *sm-window*)
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'sm-handle-event)
+ (xlib:display-finish-output *display*)))
+ (xlib:free-gcontext *sm-gc*)
+ (xlib:close-font *sm-font*)
+ (xlib:destroy-window *sm-window*)
+ (xungrab-keyboard)
+ (xungrab-pointer)
+ (grab-main-keys)
+ (show-all-childs))
+ (wait-no-key-or-button-press)
+ (when *second-mode-program*
+ (do-shell *second-mode-program*)
+ (setf *second-mode-program* nil)))
+
+
+
+(defun leave-second-mode ()
+ "Leave second mode"
+ (banish-pointer)
+ (throw 'exit-second-loop nil))
+
+
+
+
Added: clfswm/clfswm-util.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm-util.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,925 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Sat Mar 1 00:03:08 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Utility
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+
+(defun add-default-group ()
+ "Add a default group"
+ (when (group-p *current-child*)
+ (let ((name (query-string "Group name")))
+ (push (create-group :name name) (group-child *current-child*))))
+ (leave-second-mode))
+
+
+(defun add-placed-group ()
+ "Add a placed group"
+ (when (group-p *current-child*)
+ (let ((name (query-string "Group name"))
+ (x (/ (query-number "Group x in percent (%)") 100))
+ (y (/ (query-number "Group y in percent (%)") 100))
+ (w (/ (query-number "Group width in percent (%)") 100))
+ (h (/ (query-number "Group height in percent (%)") 100)))
+ (push (create-group :name name :x x :y y :w w :h h)
+ (group-child *current-child*))))
+ (leave-second-mode))
+
+
+
+(defun delete-focus-window ()
+ "Delete the focus window in all groups and workspaces"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (remove-child-in-all-groups window)
+ (send-client-message window :WM_PROTOCOLS
+ (xlib:intern-atom *display* "WM_DELETE_WINDOW"))
+ (show-all-childs))))
+
+(defun destroy-focus-window ()
+ "Destroy the focus window in all groups and workspaces"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (remove-child-in-all-groups window)
+ (xlib:kill-client *display* (xlib:window-id window))
+ (show-all-childs))))
+
+(defun remove-focus-window ()
+ "Remove the focus window in the current group"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (hide-child window)
+ (remove-child-in-group window (find-father-group window))
+ (show-all-childs))))
+
+
+(defun unhide-all-windows-in-current-child ()
+ "Unhide all hidden windows into the current child"
+ (with-xlib-protect
+ (dolist (window (get-hidden-windows))
+ (unhide-window window)
+ (process-new-window window)
+ (xlib:map-window window)))
+ (show-all-childs))
+
+
+
+
+(defun find-child-under-mouse (x y)
+ "Return the child window under the mouse"
+ (with-xlib-protect
+ (let ((win nil))
+ (with-all-windows-groups (*current-root* child)
+ (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+ (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (setf win child))
+ (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
+ (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
+ (setf win (group-window child))))
+ win)))
+
+
+
+
+
+;;; Selection functions
+(defun clear-selection ()
+ "Clear the current selection"
+ (setf *child-selection* nil)
+ (display-group-info *current-root*))
+
+(defun copy-current-child ()
+ "Copy the current child to the selection"
+ (pushnew *current-child* *child-selection*)
+ (display-group-info *current-root*))
+
+
+(defun cut-current-child ()
+ "Cut the current child to the selection"
+ (copy-current-child)
+ (hide-all-childs *current-child*)
+ (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+ (setf *current-child* *current-root*)
+ (show-all-childs))
+
+(defun remove-current-child ()
+ "Remove the current child from its father group"
+ (hide-all-childs *current-child*)
+ (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+ (setf *current-child* *current-root*)
+ (leave-second-mode))
+
+
+(defun paste-selection-no-clear ()
+ "Paste the selection in the current group - Do not clear the selection after paste"
+ (let ((group-dest (typecase *current-child*
+ (xlib:window (find-father-group *current-child* *current-root*))
+ (group *current-child*))))
+ (when group-dest
+ (dolist (child *child-selection*)
+ (pushnew child (group-child group-dest)))
+ (show-all-childs))))
+
+(defun paste-selection ()
+ "Paste the selection in the current group"
+ (paste-selection-no-clear)
+ (setf *child-selection* nil)
+ (display-group-info *current-root*))
+
+
+
+
+
+
+
+;;; CONFIG - Identify mode
+(defun identify-key ()
+ "Identify a key"
+ (let* ((done nil)
+ (font (xlib:open-font *display* *identify-font-string*))
+ (window (xlib:create-window :parent *root*
+ :x 0 :y 0
+ :width (- (xlib:screen-width *screen*) 2)
+ :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+ :background (get-color *identify-background*)
+ :border-width 1
+ :border (get-color *identify-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *identify-foreground*)
+ :background (get-color *identify-background*)
+ :font font
+ :line-style :solid)))
+ (labels ((print-key (code keysym key modifiers)
+ (xlib:clear-area window)
+ (setf (xlib:gcontext-foreground gc) (get-color *identify-foreground*))
+ (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5)
+ (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
+ (when code
+ (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (format nil "Code=~A KeySym=~A Key=~S Modifiers=~A"
+ code keysym key modifiers))))
+ (handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (let* ((modifiers (xlib:make-state-keys state))
+ (key (keycode->char code state))
+ (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+ (setf done (and (equal key #\q) (null modifiers)))
+ (dbg code keysym key modifiers)
+ (print-key code keysym key modifiers)
+ (force-output)))
+ (handle-identify (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-identify-key event-slots) t)
+ (:exposure (print-key nil nil nil nil)))
+ t))
+ (xgrab-pointer *root* 92 93)
+ (xlib:map-window window)
+ (format t "~&Press 'q' to stop the identify loop~%")
+ (print-key nil nil nil nil)
+ (force-output)
+ (unwind-protect
+ (loop until done do
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-identify))
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (xgrab-pointer *root* 66 67)))))
+
+
+
+(defun query-show-paren (orig-string pos)
+ "Replace matching parentheses with brackets"
+ (let ((string (copy-seq orig-string)))
+ (labels ((have-to-find-right? ()
+ (and (< pos (length string)) (char= (aref string pos) #\()))
+ (have-to-find-left? ()
+ (and (> (1- pos) 0) (char= (aref string (1- pos)) #\))))
+ (pos-right ()
+ (loop :for p :from (1+ pos) :below (length string)
+ :with level = 1 :for c = (aref string p)
+ :do (when (char= c #\() (incf level))
+ (when (char= c #\)) (decf level))
+ (when (= level 0) (return p))))
+ (pos-left ()
+ (loop :for p :from (- pos 2) :downto 0
+ :with level = 1 :for c = (aref string p)
+ :do (when (char= c #\() (decf level))
+ (when (char= c #\)) (incf level))
+ (when (= level 0) (return p)))))
+ (when (have-to-find-right?)
+ (let ((p (pos-right)))
+ (when p (setf (aref string p) #\]))))
+ (when (have-to-find-left?)
+ (let ((p (pos-left)))
+ (when p (setf (aref string p) #\[))))
+ string)))
+
+
+;;; CONFIG - Query string mode
+(let ((history nil))
+ (defun clear-history ()
+ "Clear the query-string history"
+ (setf history nil))
+
+ (defun query-string (msg &optional (default ""))
+ "Query a string from the keyboard. Display msg as prompt"
+ (let* ((done nil)
+ (font (xlib:open-font *display* *query-font-string*))
+ (window (xlib:create-window :parent *root*
+ :x 0 :y 0
+ :width (- (xlib:screen-width *screen*) 2)
+ :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+ :background (get-color *query-background*)
+ :border-width 1
+ :border (get-color *query-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *query-foreground*)
+ :background (get-color *query-background*)
+ :font font
+ :line-style :solid))
+ (result-string default)
+ (pos (length default))
+ (local-history history))
+ (labels ((add-cursor (string)
+ (concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
+ (print-string ()
+ (xlib:clear-area window)
+ (setf (xlib:gcontext-foreground gc) (get-color *query-foreground*))
+ (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5) msg)
+ (when (< pos 0) (setf pos 0))
+ (when (> pos (length result-string)) (setf pos (length result-string)))
+ (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (add-cursor (query-show-paren result-string pos))))
+ (call-backspace (modifiers)
+ (let ((del-pos (if (member :control modifiers)
+ (or (position #\Space result-string :from-end t :end pos) 0)
+ (1- pos))))
+ (when (>= del-pos 0)
+ (setf result-string (concatenate 'string
+ (subseq result-string 0 del-pos)
+ (subseq result-string pos))
+ pos del-pos))))
+ (call-delete (modifiers)
+ (let ((del-pos (if (member :control modifiers)
+ (1+ (or (position #\Space result-string :start pos) (1- (length result-string))))
+ (1+ pos))))
+ (if (<= del-pos (length result-string))
+ (setf result-string (concatenate 'string
+ (subseq result-string 0 pos)
+ (subseq result-string del-pos))))))
+ (call-delete-eof ()
+ (setf result-string (subseq result-string 0 pos)))
+ (handle-query-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (let* ((modifiers (xlib:make-state-keys state))
+ (keysym (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
+ ((member :mod-5 modifiers) 2)
+ (t 0))))
+ (char (xlib:keysym->character *display* keysym))
+ (keysym-name (keysym->keysym-name keysym)))
+ (setf done (cond ((string-equal keysym-name "Return") :Return)
+ ((string-equal keysym-name "Tab") :Complet)
+ ((string-equal keysym-name "Escape") :Escape)
+ (t nil)))
+ (cond ((string-equal keysym-name "Left")
+ (when (> pos 0)
+ (setf pos (if (member :control modifiers)
+ (let ((p (position #\Space result-string
+ :end (min (1- pos) (length result-string))
+ :from-end t)))
+ (if p p 0))
+ (1- pos)))))
+ ((string-equal keysym-name "Right")
+ (when (< pos (length result-string))
+ (setf pos (if (member :control modifiers)
+ (let ((p (position #\Space result-string
+ :start (min (1+ pos) (length result-string)))))
+ (if p p (length result-string)))
+ (1+ pos)))))
+ ((string-equal keysym-name "Up")
+ (setf result-string (first local-history)
+ pos (length result-string)
+ local-history (rotate-list local-history)))
+ ((string-equal keysym-name "Down")
+ (setf result-string (first local-history)
+ pos (length result-string)
+ local-history (anti-rotate-list local-history)))
+ ((string-equal keysym-name "Home") (setf pos 0))
+ ((string-equal keysym-name "End") (setf pos (length result-string)))
+ ((string-equal keysym-name "Backspace") (call-backspace modifiers))
+ ((string-equal keysym-name "Delete") (call-delete modifiers))
+ ((and (string-equal keysym-name "k") (member :control modifiers))
+ (call-delete-eof))
+ ((and (characterp char) (standard-char-p char))
+ (setf result-string (concatenate 'string
+ (when (<= pos (length result-string))
+ (subseq result-string 0 pos))
+ (string char)
+ (when (< pos (length result-string))
+ (subseq result-string pos))))
+ (incf pos)))
+ (print-string)))
+ (handle-query (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-query-key event-slots) t)
+ (:exposure (print-string)))
+ t))
+ (xgrab-pointer *root* 92 93)
+ (xlib:map-window window)
+ (print-string)
+ (wait-no-key-or-button-press)
+ (unwind-protect
+ (loop until (member done '(:Return :Escape :Complet)) do
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-query))
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (xgrab-pointer *root* 66 67)))
+ (values (when (member done '(:Return :Complet))
+ (push result-string history)
+ result-string)
+ done))))
+
+
+
+(defun query-number (msg)
+ "Query a number from the query input"
+ (parse-integer (or (query-string msg) "") :junk-allowed t))
+
+
+
+(defun eval-from-query-string ()
+ "Eval a lisp form from the query input"
+ (let ((form (query-string "Eval:"))
+ (result nil))
+ (when (and form (not (equal form "")))
+ (let ((printed-result
+ (with-output-to-string (*standard-output*)
+ (setf result (handler-case
+ (loop for i in (multiple-value-list
+ (eval (read-from-string form)))
+ collect (format nil "~S" i))
+ (error (condition)
+ (format nil "~A" condition)))))))
+ (info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
+ (ensure-list printed-result)
+ (ensure-list result)))
+ :width (- (xlib:screen-width *screen*) 2))
+ (eval-from-query-string)))))
+
+
+
+
+(defun run-program-from-query-string ()
+ "Run a program from the query input"
+ (let ((program (query-string "Run:")))
+ (when (and program (not (equal program "")))
+ (setf *second-mode-program* program)
+ (leave-second-mode))))
+
+
+
+
+;;; Group name actions
+;;;(loop :for str :in '("The Gimp" "The klm" "klm" "abc") ;; Test
+;;; :when (zerop (or (search "ThE" str :test #'string-equal) -1))
+;;; :collect str)
+(defun ask-group-name (msg)
+ "Ask a group name"
+ (let ((all-group-name nil)
+ (name ""))
+ (with-all-groups (*root-group* group)
+ (awhen (group-name group) (push it all-group-name)))
+ (labels ((selected-names ()
+ (loop :for str :in all-group-name
+ :when (zerop (or (search name str :test #'string-equal) -1))
+ :collect str))
+ (complet-alone (req sel)
+ (if (= 1 (length sel)) (first sel) req))
+ (ask ()
+ (let* ((selected (selected-names))
+ (default (complet-alone name selected)))
+ (multiple-value-bind (str done)
+ (query-string (format nil "~A: ~{~A~^, ~}" msg selected) default)
+ (setf name str)
+ (when (or (not (string-equal name default)) (eql done :complet))
+ (ask))))))
+ (ask))
+ name))
+
+
+
+;;; Focus by functions
+(defun focus-group-by (group)
+ (when (group-p group)
+ (focus-all-childs group (or (find-father-group group *current-root*)
+ (find-father-group group)
+ *root-group*))))
+
+
+(defun focus-group-by-name ()
+ "Focus a group by name"
+ (focus-group-by (find-group-by-name (ask-group-name "Focus group")))
+ (leave-second-mode))
+
+(defun focus-group-by-number ()
+ "Focus a group by number"
+ (focus-group-by (find-group-by-number (query-number "Focus group by number:")))
+ (leave-second-mode))
+
+
+;;; Open by functions
+(defun open-group-by (group)
+ (when (group-p group)
+ (push (create-group :name (query-string "Group name")) (group-child group))))
+
+
+
+(defun open-group-by-name ()
+ "Open a new group in a named group"
+ (open-group-by (find-group-by-name (ask-group-name "Open a new group in")))
+ (leave-second-mode))
+
+(defun open-group-by-number ()
+ "Open a new group in a numbered group"
+ (open-group-by (find-group-by-name (ask-group-name "Open a new group in the grou numbered:")))
+ (leave-second-mode))
+
+
+;;; Delete by functions
+(defun delete-group-by (group)
+ (unless (equal group *root-group*)
+ (when (equal group *current-root*)
+ (setf *current-root* *root-group*))
+ (when (equal group *current-child*)
+ (setf *current-child* *current-root*))
+ (remove-child-in-group group (find-father-group group))))
+
+
+(defun delete-group-by-name ()
+ "Delete a group by name"
+ (delete-group-by (find-group-by-name (ask-group-name "Delete group")))
+ (leave-second-mode))
+
+(defun delete-group-by-number ()
+ "Delete a group by number"
+ (delete-group-by (find-group-by-number (query-number "Delete group by number:")))
+ (leave-second-mode))
+
+
+;;; Move by function
+(defun move-current-child-by (child group-dest)
+ (when (and child (group-p group-dest))
+ (remove-child-in-group child (find-father-group child))
+ (pushnew child (group-child group-dest))
+ (focus-all-childs child group-dest)))
+
+(defun move-current-child-by-name ()
+ "Move current child in a named group"
+ (move-current-child-by *current-child*
+ (find-group-by-name
+ (ask-group-name (format nil "Move '~A' to group" (child-name *current-child*)))))
+ (leave-second-mode))
+
+(defun move-current-child-by-number ()
+ "Move current child in a numbered group"
+ (move-current-child-by *current-child*
+ (find-group-by-number
+ (query-number (format nil "Move '~A' to group numbered:" (child-name *current-child*)))))
+ (leave-second-mode))
+
+
+;;; Copy by function
+(defun copy-current-child-by (child group-dest)
+ (when (and child (group-p group-dest))
+ (pushnew child (group-child group-dest))
+ (focus-all-childs child group-dest)))
+
+(defun copy-current-child-by-name ()
+ "Copy current child in a named group"
+ (copy-current-child-by *current-child*
+ (find-group-by-name
+ (ask-group-name (format nil "Copy '~A' to group" (child-name *current-child*)))))
+ (leave-second-mode))
+
+(defun copy-current-child-by-number ()
+ "Copy current child in a numbered group"
+ (copy-current-child-by *current-child*
+ (find-group-by-number
+ (query-number (format nil "Copy '~A' to group numbered:" (child-name *current-child*)))))
+ (leave-second-mode))
+
+
+
+
+
+
+;;;;;,-----
+;;;;;| Various definitions
+;;;;;`-----
+;;(defun stop-all-pending-actions ()
+;; "Stop all pending actions (actions like open in new workspace/group)"
+;; (setf *open-next-window-in-new-workspace* nil
+;; *open-next-window-in-new-group* nil
+;; *arrow-action* nil
+;; *pager-arrow-action* nil))
+;;
+;;(defun rotate-window-up ()
+;; "Rotate up windows in the current group"
+;; (setf (group-window-list (current-group))
+;; (rotate-list (group-window-list (current-group))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun rotate-window-down ()
+;; "Rotate down windows in the current group"
+;; (setf (group-window-list (current-group))
+;; (anti-rotate-list (group-window-list (current-group))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;(defun maximize-group (group)
+;; "Maximize the group"
+;; (when group
+;; (unless (group-fullscreenp group)
+;; (setf (group-fullscreenp group) t)
+;; (show-all-windows-in-workspace (current-workspace)))))
+;;
+;;(defun minimize-group (group)
+;; "Minimize the group"
+;; (when group
+;; (when (group-fullscreenp group)
+;; (setf (group-fullscreenp group) nil)
+;; (show-all-windows-in-workspace (current-workspace)))))
+;;
+;;(defun toggle-maximize-group (group)
+;; "Maximize/minimize a group"
+;; (if (group-fullscreenp group)
+;; (minimize-group group)
+;; (maximize-group group)))
+;;
+;;
+;;(defun toggle-maximize-current-group ()
+;; "Maximize/minimize the current group"
+;; (toggle-maximize-group (current-group)))
+;;
+;;
+;;(defun renumber-workspaces ()
+;; "Reset workspaces numbers (1 for current workspace, 2 for the second...) "
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (setf *current-workspace-number* 0)
+;; (loop for workspace in *workspace-list* do
+;; (setf (workspace-number workspace) (incf *current-workspace-number*)))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;(defun sort-workspaces ()
+;; "Sort workspaces by numbers"
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (setf *workspace-list* (sort *workspace-list*
+;; #'(lambda (x y)
+;; (< (workspace-number x) (workspace-number y)))))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;
+;;(defun circulate-group-up ()
+;; "Circulate up in group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (setf (workspace-group-list (current-workspace))
+;; (rotate-list (workspace-group-list (current-workspace))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;(defun circulate-group-up-move-window ()
+;; "Circulate up in group moving the current window in the next group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (let ((window (current-window)))
+;; (remove-window-in-group window (current-group))
+;; (focus-window (current-window))
+;; (setf (workspace-group-list (current-workspace))
+;; (rotate-list (workspace-group-list (current-workspace))))
+;; (add-window-in-group window (current-group)))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun circulate-group-up-copy-window ()
+;; "Circulate up in group copying the current window in the next group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (let ((window (current-window)))
+;; (setf (workspace-group-list (current-workspace))
+;; (rotate-list (workspace-group-list (current-workspace))))
+;; (unless (window-already-in-workspace window (current-workspace))
+;; (add-window-in-group window (current-group))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;
+;;(defun circulate-group-down ()
+;; "Circulate down in group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (setf (workspace-group-list (current-workspace))
+;; (anti-rotate-list (workspace-group-list (current-workspace))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun circulate-group-down-move-window ()
+;; "Circulate down in group moving the current window in the next group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (let ((window (current-window)))
+;; (remove-window-in-group window (current-group))
+;; (focus-window (current-window))
+;; (setf (workspace-group-list (current-workspace))
+;; (anti-rotate-list (workspace-group-list (current-workspace))))
+;; (add-window-in-group window (current-group)))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun circulate-group-down-copy-window ()
+;; "Circulate down in group copying the current window in the next group"
+;; (banish-pointer)
+;; (minimize-group (current-group))
+;; (no-focus)
+;; (let ((window (current-window)))
+;; (setf (workspace-group-list (current-workspace))
+;; (anti-rotate-list (workspace-group-list (current-workspace))))
+;; (unless (window-already-in-workspace window (current-workspace))
+;; (add-window-in-group window (current-group))))
+;; (adapt-window-to-group (current-window) (current-group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;
+;;
+;;
+;;(defun circulate-workspace-by-number (number)
+;; "Focus a workspace given its number"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (dotimes (i (length *workspace-list*))
+;; (when (= (workspace-number (current-workspace)) number)
+;; (return))
+;; (setf *workspace-list* (rotate-list *workspace-list*)))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;(defun circulate-workspace-up ()
+;; "Circulate up in workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (setf *workspace-list* (rotate-list *workspace-list*))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;(defun circulate-workspace-up-move-group ()
+;; "Circulate up in workspace moving current group in the next workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (let ((group (current-group)))
+;; (remove-group-in-workspace group (current-workspace))
+;; (setf *workspace-list* (rotate-list *workspace-list*))
+;; (add-group-in-workspace (copy-group group) (current-workspace)))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;(defun circulate-workspace-up-copy-group ()
+;; "Circulate up in workspace copying current group in the next workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (let ((group (current-group)))
+;; (setf *workspace-list* (rotate-list *workspace-list*))
+;; (unless (group-windows-already-in-workspace group (current-workspace))
+;; (add-group-in-workspace (copy-group group) (current-workspace))))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;(defun circulate-workspace-down ()
+;; "Circulate down in workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;(defun circulate-workspace-down-move-group ()
+;; "Circulate down in workspace moving current group in the next workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (let ((group (current-group)))
+;; (remove-group-in-workspace group (current-workspace))
+;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
+;; (add-group-in-workspace (copy-group group) (current-workspace)))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;(defun circulate-workspace-down-copy-group ()
+;; "Circulate down in workspace copying current group in the next workspace"
+;; (no-focus)
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (let ((group (current-group)))
+;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
+;; (unless (group-windows-already-in-workspace group (current-workspace))
+;; (add-group-in-workspace (copy-group group) (current-workspace))))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;(defun delete-current-window ()
+;; "Delete the current window in all groups and workspaces"
+;; (let ((window (current-window)))
+;; (when window
+;; (no-focus)
+;; (remove-window-in-all-workspace window)
+;; (send-client-message window :WM_PROTOCOLS
+;; (intern-atom *display* "WM_DELETE_WINDOW"))))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;(defun destroy-current-window ()
+;; "Destroy the current window in all groups and workspaces"
+;; (let ((window (current-window)))
+;; (when window
+;; (no-focus)
+;; (remove-window-in-all-workspace window)
+;; (kill-client *display* (xlib:window-id window))))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun remove-current-window ()
+;; "Remove the current window in the current group"
+;; (let ((window (current-window)))
+;; (when window
+;; (no-focus)
+;; (hide-window window)
+;; (remove-window-in-group (current-window) (current-group))))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun remove-current-group ()
+;; "Remove the current group in the current workspace"
+;; (minimize-group (current-group))
+;; (let ((group (current-group)))
+;; (when group
+;; (no-focus)
+;; (dolist (window (group-window-list group))
+;; (when window
+;; (hide-window window)))
+;; (remove-group-in-workspace group (current-workspace))))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun remove-current-workspace ()
+;; "Remove the current workspace"
+;; (let ((workspace (current-workspace)))
+;; (when workspace
+;; (hide-all-windows-in-workspace workspace)
+;; (remove-workspace workspace)
+;; (show-all-windows-in-workspace (current-workspace)))))
+;;
+;;
+;;(defun unhide-all-windows-in-current-group ()
+;; "Unhide all hidden windows into the current group"
+;; (let ((all-windows (get-all-windows))
+;; (hidden-windows (remove-if-not #'window-hidden-p
+;; (copy-list (xlib:query-tree *root*))))
+;; (current-group (current-group)))
+;; (dolist (window (set-difference hidden-windows all-windows))
+;; (unhide-window window)
+;; (process-new-window window)
+;; (xlib:map-window window)
+;; (adapt-window-to-group window current-group)))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;
+;;
+;;(defun create-new-default-group ()
+;; "Create a new default group"
+;; (minimize-group (current-group))
+;; (add-group-in-workspace (copy-group *default-group*)
+;; (current-workspace))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;(defun create-new-default-workspace ()
+;; "Create a new default workspace"
+;; (hide-all-windows-in-workspace (current-workspace))
+;; (add-workspace (create-default-workspace))
+;; (show-all-windows-in-workspace (current-workspace)))
+;;
+;;
+;;
+;;
+;;;;;,-----
+;;;;;| Group moving
+;;;;;`-----
+;;(defun move-group (group dx dy)
+;; "Move group"
+;; (setf (group-x group) (+ (group-x group) dx)
+;; (group-y group) (+ (group-y group) dy))
+;; (dolist (window (group-window-list group))
+;; (adapt-window-to-group window group))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun move-group-to (group x y)
+;; "Move group to"
+;; (setf (group-x group) x
+;; (group-y group) y)
+;; (dolist (window (group-window-list group))
+;; (adapt-window-to-group window group))
+;; (focus-window (current-window))
+;; (show-all-group (current-workspace)))
+;;
+;;
+;;(defun resize-group (group dx dy)
+;; "Resize group"
+;; (setf (group-width group) (max (+ (group-width group) dx) 100)
+;; (group-height group) (max (+ (group-height group) dy) 100))
+;; (dolist (window (group-window-list group))
+;; (adapt-window-to-group window group))
+;; (show-all-group (current-workspace)))
+;;
+;;(defun force-window-in-group ()
+;; "Force the current window to move in the group (Useful only for transient windows)"
+;; (let ((group (current-group))
+;; (window (current-window)))
+;; (when window
+;; (setf (xlib:drawable-x window) (group-x group)
+;; (xlib:drawable-y window) (group-y group))
+;; (show-all-windows-in-workspace (current-workspace)))))
+;;
+;;(defun force-window-center-in-group ()
+;; "Force the current window to move in the center of the group (Useful only for transient windows)"
+;; (let ((group (current-group))
+;; (window (current-window)))
+;; (when window
+;; (setf (xlib:drawable-x window) (truncate (+ (group-x group)
+;; (/ (- (group-width group) (xlib:drawable-width window)) 2)))
+;; (xlib:drawable-y window) (truncate (+ (group-y group)
+;; (/ (- (group-height group) (xlib:drawable-height window)) 2))))
+;; (show-all-windows-in-workspace (current-workspace)))))
+;;
+;;
+;;
+;;
+;;
+;;(defun show-help (&optional (browser "dillo") (tempfile "/tmp/clfswm.html"))
+;; "Show current keys and buttons bindings"
+;; (ignore-errors
+;; (produce-doc-html-in-file tempfile))
+;; (sleep 1)
+;; (do-shell (format nil "~A ~A" browser tempfile)))
Added: clfswm/clfswm.asd
==============================================================================
--- (empty file)
+++ clfswm/clfswm.asd Sat Mar 1 07:49:46 2008
@@ -0,0 +1,50 @@
+;;;; -*- Mode: Lisp -*-
+;;;; Author: Philippe Brochard <hocwp at free.fr>
+;;;; ASDF System Definition
+;;;
+;;; #date#: Fri Feb 22 21:39:37 2008
+
+(in-package #:asdf)
+
+(defsystem clfswm
+ :description "CLFSWM: Fullscreen Window Manager"
+ :version "Please, see the package date (something between 0.5 and 1.5)"
+ :author "Philippe Brochard <hocwp at free.fr>"
+ :licence "GNU Public License (GPL)"
+ :components ((:file "tools")
+ (:file "my-html"
+ :depends-on ("tools"))
+ (:file "package"
+ :depends-on ("my-html" "tools"))
+ (:file "config"
+ :depends-on ("package"))
+ (:file "keysyms"
+ :depends-on ("package"))
+ (:file "xlib-util"
+ :depends-on ("package" "keysyms" "config"))
+ (:file "netwm-util"
+ :depends-on ("package" "xlib-util"))
+ (:file "clfswm-keys"
+ :depends-on ("package" "config" "xlib-util" "keysyms"))
+ (:file "clfswm-internal"
+ :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
+ (:file "clfswm"
+ :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
+ "clfswm-internal" "tools"))
+ (:file "clfswm-second-mode"
+ :depends-on ("package" "clfswm-internal"))
+ (:file "clfswm-info"
+ :depends-on ("package" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+ (:file "clfswm-util"
+ :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode"))
+ (:file "clfswm-layout"
+ :depends-on ("package" "clfswm-util" "clfswm-info"))
+ (:file "bindings"
+ :depends-on ("clfswm" "clfswm-internal"))
+ (:file "bindings-second-mode"
+ :depends-on ("clfswm" "clfswm-util"))))
+
+
+
+
+
Added: clfswm/clfswm.lisp
==============================================================================
--- (empty file)
+++ clfswm/clfswm.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,308 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Sat Mar 1 00:02:34 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Main functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+
+
+
+;;; Main mode hooks
+(defun handle-key-press (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (funcall-key-from-code *main-keys* code state))
+
+
+
+
+(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
+ x y width height border-width value-mask &allow-other-keys)
+ (declare (ignore event-slots))
+ (labels ((has-x (mask) (= 1 (logand mask 1)))
+ (has-y (mask) (= 2 (logand mask 2)))
+ (has-w (mask) (= 4 (logand mask 4)))
+ (has-h (mask) (= 8 (logand mask 8)))
+ (has-bw (mask) (= 16 (logand mask 16)))
+ (has-stackmode (mask) (= 64 (logand mask 64)))
+ (adjust-from-request ()
+ (when (has-x value-mask) (setf (xlib:drawable-x window) x))
+ (when (has-y value-mask) (setf (xlib:drawable-y window) y))
+ (when (has-h value-mask) (setf (xlib:drawable-height window) height))
+ (when (has-w value-mask) (setf (xlib:drawable-width window) width))))
+ (with-xlib-protect
+ (xlib:with-state (window)
+ (when (has-bw value-mask)
+ (setf (xlib:drawable-border-width window) border-width))
+ (if (find-child window *current-root*)
+ (case (window-type window)
+ (:normal (adapt-child-to-father window (find-father-group window *current-root*))
+ (send-configuration-notify window))
+ (t (adjust-from-request)))
+ (adjust-from-request))
+ (when (has-stackmode value-mask)
+ (case stack-mode
+ (:above (raise-window window))))))))
+
+
+
+
+(defun handle-configure-notify (&rest event-slots)
+ (declare (ignore event-slots)))
+
+
+
+
+(defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless send-event-p
+ ;; (unhide-window window)
+ (process-new-window window)
+ (xlib:map-window window)
+ ;; (focus-window window)
+ (show-all-childs)))
+
+
+(defun handle-unmap-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (and (not send-event-p)
+ (not (xlib:window-equal window event-window)))
+ (when (find-child window *root-group*)
+ (remove-child-in-all-groups window)
+ (show-all-childs))))
+
+
+(defun handle-destroy-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (or send-event-p
+ (xlib:window-equal window event-window))
+ (when (find-child window *root-group*)
+ (remove-child-in-all-groups window)
+ (show-all-childs))))
+
+
+
+(defun handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots root-x root-y)))
+
+
+
+(defun handle-exposure (&rest event-slots &key window &allow-other-keys)
+ (declare (ignore event-slots))
+ (awhen (find-group-window window *current-root*)
+ (display-group-info it)))
+
+
+(defun handle-create-notify (&rest event-slots)
+ (declare (ignore event-slots)))
+
+
+
+;; PHIL: TODO: focus-policy par group
+;; :click, :sloppy, :nofocus
+(defun handle-click-to-focus (window)
+ (let ((to-replay t)
+ (child window)
+ (father (find-father-group window *current-root*)))
+ (unless father
+ (setf child (find-group-window window *current-root*)
+ father (find-father-group child *current-root*)))
+ (when (and child father (focus-all-childs child father))
+ (show-all-childs)
+ (setf to-replay nil))
+ (if to-replay (replay-button-event) (stop-button-event))))
+
+
+(defun handle-button-press (&rest event-slots &key code state window &allow-other-keys)
+ (declare (ignore event-slots))
+ (if (and (= code 1) (= state 0))
+ (handle-click-to-focus window)
+ (replay-button-event)))
+
+
+
+
+
+
+;;; CONFIG: Main mode hooks
+(setf *key-press-hook* #'handle-key-press
+ *configure-request-hook* #'handle-configure-request
+ *configure-notify-hook* #'handle-configure-notify
+ *destroy-notify-hook* 'handle-destroy-notify
+ *enter-notify-hook* #'handle-enter-notify
+ *exposure-hook* 'handle-exposure
+ *map-request-hook* #'handle-map-request
+ *unmap-notify-hook* 'handle-unmap-notify
+ *create-notify-hook* #'handle-create-notify
+ *button-press-hook* 'handle-button-press)
+
+
+
+
+(defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ ;;(dbg event-key)
+ (with-xlib-protect
+ (case event-key
+ (:button-press (call-hook *button-press-hook* event-slots))
+ (:motion-notify (call-hook *button-motion-notify-hook* event-slots))
+ (:key-press (call-hook *key-press-hook* event-slots))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots))
+ (:enter-notify (call-hook *enter-notify-hook* event-slots))
+ (:exposure (call-hook *exposure-hook* event-slots))))
+ t)
+
+
+
+(defun main-loop ()
+ (loop
+ (with-xlib-protect
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-event))))
+;;(dbg "Main loop finish" c)))))
+
+
+(defun open-display (display-str protocol)
+ (multiple-value-bind (host display-num) (parse-display-string display-str)
+ (setf *display* (xlib:open-display host :display display-num :protocol protocol)
+ (getenv "DISPLAY") display-str)))
+
+
+(defun init-display ()
+ (setf *screen* (first (xlib:display-roots *display*))
+ *root* (xlib:screen-root *screen*)
+ *no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
+ *root-gc* (xlib:create-gcontext :drawable *root*
+ :foreground (get-color *color-unselected*)
+ :background (get-color "Black")
+ :line-style :solid)
+ *default-font* (xlib:open-font *display* *default-font-string*))
+ (xgrab-init-pointer)
+ (xgrab-init-keyboard)
+ ;;(xgrab-pointer *root* 66 67 '(:enter-window :button-press :button-release) t) ;; PHIL
+ ;;(grab-pointer *root* '(:button-press :button-release)
+ ;; :owner-p t :sync-keyboard-p nil :sync-pointer-p nil)
+ ;;(grab-button *root* 1 nil ;;'(:button-press :button-release)
+ ;; :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil)
+ ;;(xlib:grab-pointer *root* nil :owner-p nil)
+ (xlib:map-window *no-focus-window*)
+ (dbg *display*)
+ (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
+ :substructure-notify
+ :property-change
+ :exposure
+ :button-press))
+ ;;(intern-atoms *display*)
+ (netwm-set-properties)
+ (xlib:display-force-output *display*)
+ (setf *child-selection* nil)
+ (setf *root-group* (create-group :name "Root" :number 0 :layout #'tile-space-layout)
+ *current-root* *root-group*
+ *current-child* *current-root*)
+ (call-hook *init-hook*)
+ (process-existing-windows *screen*)
+ (show-all-childs)
+ (grab-main-keys)
+ (xlib:display-finish-output *display*))
+
+
+
+(defun xdg-config-home ()
+ (pathname-directory (concatenate 'string (or (getenv "XDG_CONFIG_HOME")
+ (getenv "HOME"))
+ "/")))
+
+
+(defun read-conf-file ()
+ (let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))
+ (etc-conf (probe-file #p"/etc/clfswmrc"))
+ (config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm"))
+ :name "clfswmrc")))
+ (conf (or user-conf etc-conf config-user-conf)))
+ (if conf
+ (handler-case (load conf)
+ (error (c)
+ (format t "~2%*** Error loading configurtion file: ~A ***~&~A~%" conf c)
+ (values nil (format nil "~s" c) conf))
+ (:no-error (&rest args)
+ (declare (ignore args))
+ (values t nil conf)))
+ (values t nil nil))))
+
+
+
+(defun main (&optional (display-str (or (getenv "DISPLAY") ":0")) protocol)
+ (read-conf-file)
+ (handler-case
+ (open-display display-str protocol)
+ (xlib:access-error (c)
+ (format t "~&~A~&Maybe another window manager is running.~%" c)
+ (force-output)
+ (return-from main 'init-display-error)))
+ (handler-case
+ (init-display)
+ (xlib:access-error (c)
+ (ungrab-main-keys)
+ (xlib:destroy-window *no-focus-window*)
+ (xlib:close-display *display*)
+ (format t "~&~A~&Maybe another window manager is running.~%" c)
+ (force-output)
+ (return-from main 'init-display-error)))
+ (unwind-protect
+ (catch 'exit-main-loop
+ (main-loop))
+ (ungrab-main-keys)
+ (xlib:destroy-window *no-focus-window*)
+ (xlib:close-display *display*)))
+
+
+
+
+;;(defun perform-click (type code state time)
+;; "Send a button-{press, release} event for button-number. The type of the
+;; sent event will be determined according to the type of the ev event
+;; argument: if type key-press then send button-press, if key-release then
+;; button-release is sent. The destination window will be retreived in the
+;; ev event argument."
+;; (flet ((my-query (win) (multiple-value-list (xlib:query-pointer win))))
+;; (loop with window = *root*
+;; for (x y ssp child nil root-x root-y root) = (my-query window)
+;; while child do (setf window child)
+;; finally
+;; (progn
+;; (dbg window)
+;; (xlib:send-event window type nil
+;; :x x :y y :root-x root-x :root-y root-y
+;; :state state :code code
+;; :window window :event-window window :root root :child child
+;; :same-screen-p ssp :time time)))))
Added: clfswm/clisp-load.lisp
==============================================================================
--- (empty file)
+++ clfswm/clisp-load.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,59 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 26 23:00:50 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: System loading functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+
+(defparameter *base-dir* (directory-namestring *load-truename*))
+
+#+CMU
+(setf ext:*gc-verbose* nil)
+
+#+CMU
+(require :clx)
+
+#+SBCL
+(require :asdf)
+
+#+SBCL
+(require :sb-posix)
+
+#+SBCL
+(require :clx)
+
+#-ASDF
+(load (make-pathname :host (pathname-host *base-dir*)
+ :device (pathname-device *base-dir*)
+ :directory (pathname-directory *base-dir*)
+ :name "asdf" :type "lisp"))
+
+(push *base-dir* asdf:*central-registry*)
+
+
+(asdf:oos 'asdf:load-op :clfswm)
+
+(in-package :clfswm)
+
+(clfswm:main ":1")
Added: clfswm/config.lisp
==============================================================================
--- (empty file)
+++ clfswm/config.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,122 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Wed Feb 27 22:15:01 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Configuration file
+;;;
+;;; Change this file to your own needs or update some of this variables in
+;;; your ~/.clfswmrc
+;;; Some simple hack can be done in the code begining with the word CONFIG
+;;; (you can do a 'grep CONFIG *.lisp' to see what you can configure)
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+;;; CONFIG - Compress motion notify ?
+(defparameter *have-to-compress-notify* nil
+ "This variable may be useful to speed up some slow version of CLX.
+It is particulary useful with CLISP/MIT-CLX.")
+
+
+
+;;; CONFIG - Screen size
+(defun get-fullscreen-size ()
+ "Return the size of root child (values rx ry rw rh raise-p)
+You can tweak this to what you want"
+ (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*) nil))
+;; (values -1 -1 1024 768))
+;; (values 100 100 800 600))
+
+
+
+
+
+
+;;; CONFIG: Main mode colors
+(defparameter *color-selected* "Red")
+(defparameter *color-unselected* "Blue")
+(defparameter *color-maybe-selected* "Yellow")
+
+;;; CONFIG: Second mode colors and fonts
+(defparameter *sm-border-color* "Green")
+(defparameter *sm-background-color* "Black")
+(defparameter *sm-foreground-color* "Red")
+(defparameter *sm-font-string* "9x15bold")
+(defparameter *sm-width* 300)
+(defparameter *sm-height* 25)
+
+
+;;; CONFIG - Pager mode colors and fonts
+(defparameter *pager-background* "black")
+(defparameter *pager-workspace-border* "blue")
+(defparameter *pager-workspace-background* "black")
+(defparameter *pager-group-border* "yellow")
+(defparameter *pager-group-border-selected* "red")
+(defparameter *pager-group-background* "grey10")
+
+(defparameter *pager-window-selected* "Green")
+(defparameter *pager-window-deselected* "Yellow")
+(defparameter *pager-window-hidden* "Green")
+(defparameter *pager-window-hidden-1* "Red")
+
+(defparameter *pager-window-separator* "blue")
+
+(defparameter *pager-workspace-cursor* "black")
+(defparameter *pager-line-cursor* "blue")
+(defparameter *pager-group-cursor* "white")
+(defparameter *pager-group-background-cursor* "grey35")
+
+
+(defparameter *pager-font-string* "9x15bold")
+
+(defparameter *pager-workspace-height* 200)
+
+
+
+;;; CONFIG - Identify key colors
+(defparameter *identify-font-string* "9x15")
+(defparameter *identify-background* "black")
+(defparameter *identify-foreground* "green")
+(defparameter *identify-border* "red")
+
+;;; CONFIG - Query string colors
+(defparameter *query-font-string* "9x15")
+(defparameter *query-background* "black")
+(defparameter *query-foreground* "green")
+(defparameter *query-border* "red")
+
+
+;;; CONFIG - Info mode
+
+(defparameter *info-background* "black")
+(defparameter *info-foreground* "green")
+(defparameter *info-border* "red")
+(defparameter *info-line-cursor* "white")
+(defparameter *info-font-string* "9x15")
+
+
+
+;;; Tiling to side parameters
+(defparameter *tile-workspace-function* 'tile-workspace-top)
+(defparameter *tile-border-size* 200)
Added: clfswm/dot-clfswmrc
==============================================================================
--- (empty file)
+++ clfswm/dot-clfswmrc Sat Mar 1 07:49:46 2008
@@ -0,0 +1,272 @@
+;;; -*- lisp -*-
+;;;
+;;; CLFSWM configuration file example
+;;;
+;;; Send me your configuration file at hocwp _at_ free -dot- fr if
+;;; you want to share it with others.
+
+(in-package :clfswm)
+
+
+;;;; Uncomment the line above if you want to enable the notify event compression.
+;;;; This variable may be useful to speed up some slow version of CLX
+;;;; It is particulary useful with CLISP/MIT-CLX.
+;; (setf *have-to-compress-notify* t)
+
+
+;;; Color configuration example
+;;;
+;;; See in package.lisp for all variables
+(setf *color-unselected* "Blue")
+
+
+;;(defparameter *fullscreen* '(0 4 800 570))
+(defparameter *fullscreen* '(0 0 1024 750))
+
+
+
+;;; Binding example: Undefine Control-F1 and define Control-F5 as a
+;;; new binding in main mode
+;;;
+;;; See bindings.lisp, bindings-second-mode.lisp and bindings-pager.lisp
+;;; for all default bindings definitions.
+(undefine-main-key ("F1" :mod-1))
+(define-main-key ("F5" :mod-1) 'help-on-clfswm)
+
+
+
+;;; Binding example for apwal
+(define-second-key (#\Space)
+ (defun tpm-apwal ()
+ "Run Apwal"
+ (do-shell "exec apwal")
+ (show-all-windows-in-workspace (current-workspace))
+ (throw 'exit-second-loop nil)))
+
+
+
+
+
+;;;; Reloading example
+(defun reload-clfswm ()
+ "Reload clfswm"
+ (format t "RELOADING... ")
+ (ungrab-main-keys)
+ (setf *main-keys* (make-hash-table :test 'equal))
+ (asdf:oos 'asdf:load-op :clfswm)
+ (grab-main-keys)
+ (format t "Done!~%"))
+
+
+(define-main-key ("F2" :mod-1) 'reload-clfswm)
+
+(define-main-key ("F3" :mod-1) (lambda ()
+ (do-shell "rxvt")))
+
+
+
+;;; Hook example
+;;;
+;;; See in package.lisp and clfswm.lisp, clfswm-second-mode.lisp
+;;; or clfswm-pager.lisp for hook examples
+(setf *key-press-hook* (list (lambda (&rest args) ; function 1
+ (format t "Keyp press (before): ~A~%" args)
+ (force-output))
+ #'handle-key-press ; function 2 (default)
+ (lambda (&rest args) ; function 3
+ (declare (ignore args))
+ (format t "Keyp press (after)~%")
+ (force-output))))
+
+
+
+;;; A more complex example I use to record my desktop and show
+;;; documentation associated to each key press.
+(defun documentation-key-from-code (hash-key code state)
+ (labels ((doc-from (key)
+ (multiple-value-bind (function foundp)
+ (gethash (list key state) hash-key)
+ (when (and foundp (first function))
+ (documentation (first function) 'function))))
+ (from-code ()
+ (doc-from code))
+ (from-char ()
+ (let ((char (keycode->char code state)))
+ (doc-from char)))
+ (from-string ()
+ (let ((string (keysym->keysym-name (keycode->keysym *display* code 0))))
+ (doc-from string))))
+ (cond ((from-code))
+ ((from-char))
+ ((from-string)))))
+
+
+(defun key-string (hash-key code state)
+ (let* ((modifiers (make-state-keys state))
+ (keysym (keysym->keysym-name (keycode->keysym *display* code 0)))
+ (doc (documentation-key-from-code hash-key code state)))
+ (values (format nil "~:(~{~A+~}~A~) : ~S" modifiers keysym doc)
+ doc)))
+
+(defun display-doc (hash-key code state)
+ (multiple-value-bind (str doc)
+ (key-string hash-key code state)
+ (when doc
+ (do-shell "pkill osd_cat")
+ (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -45 -f -*-fixed-*-*-*-*-12-*-*-*-*-*-*-1" str))
+ (force-output))))
+
+(defun display-key-osd-main (&rest event-slots &key code state &allow-other-keys)
+ (display-doc *main-keys* code state))
+
+(defun display-key-osd-second (&rest event-slots &key code state &allow-other-keys)
+ (display-doc *second-keys* code state))
+
+(defun display-key-pager (&rest event-slots &key code state &allow-other-keys)
+ (setf (gcontext-background *pager-gc*) (get-color "Black"))
+ (setf (gcontext-foreground *pager-gc*) (get-color "Red"))
+ (multiple-value-bind (str doc)
+ (key-string *pager-keys* code state)
+ (when doc
+ (draw-image-glyphs *pager-window* *pager-gc* 20 570
+ (format nil "~A " str)))
+ (display-finish-output *display*)))
+
+;; Define new hook or add to precedent one
+(if (consp *key-press-hook*)
+ (push #'display-key-osd-main *key-press-hook*)
+ (setf *key-press-hook* (list #'display-key-osd-main #'handle-key-press)))
+(setf *sm-key-press-hook* (list #'display-key-osd-second #'sm-handle-key-press))
+(setf *pager-key-press-hook* (list #'pager-handle-key-press #'display-key-pager))
+
+;;; -- Doc example end --
+
+
+
+;;;; Uncomment the lines below if you want to enable the larswm,
+;;;; dwm, wmii... cycling style.
+;;;;
+;;;; This leave the main window in one side of the screen and tile others
+;;;; on the other side. It can be configured in the rc file or interactively
+;;;; with the function 'reconfigure-tile-workspace'.
+;;;;
+(defun circulate-group-up ()
+ "Circulate up in group - larswm, dwm, wmii style"
+ (banish-pointer)
+ (minimize-group (current-group))
+ (no-focus)
+ (setf (workspace-group-list (current-workspace))
+ (rotate-list (workspace-group-list (current-workspace))))
+ (funcall *tile-workspace-function* (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-group-down ()
+ "Circulate down in group - larswm, dwm, wmii style"
+ (banish-pointer)
+ (minimize-group (current-group))
+ (no-focus)
+ (setf (workspace-group-list (current-workspace))
+ (anti-rotate-list (workspace-group-list (current-workspace))))
+ (funcall *tile-workspace-function* (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+;;; -- Lasrwm style end --
+
+
+
+;;; Azerty keyboard configuration (first remove keys, then rebind)
+;; Main mode
+;;(undefine-main-key (#\t :mod-1))
+;;(undefine-main-key (#\b :mod-1))
+;;(undefine-main-key (#\b :mod-1 :control))
+;;(undefine-main-key ("1" :mod-1))
+;;(undefine-main-key ("2" :mod-1))
+;;(undefine-main-key ("3" :mod-1))
+;;(undefine-main-key ("4" :mod-1))
+;;(undefine-main-key ("5" :mod-1))
+;;(undefine-main-key ("6" :mod-1))
+;;(undefine-main-key ("7" :mod-1))
+;;(undefine-main-key ("8" :mod-1))
+;;(undefine-main-key ("9" :mod-1))
+;;(undefine-main-key ("0" :mod-1))
+;; Or better:
+(undefine-main-multi-keys (#\t :mod-1) (#\b :mod-1) (#\b :mod-1 :control)
+ (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
+ (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
+ (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1))
+
+(define-main-key (#\< :control) 'second-key-mode)
+
+(define-main-key ("twosuperior") 'banish-pointer)
+(define-main-key ("twosuperior" :mod-1) 'toggle-maximize-current-group)
+
+(define-main-key ("ampersand" :mod-1) 'b-main-focus-workspace-1)
+(define-main-key ("eacute" :mod-1) 'b-main-focus-workspace-2)
+(define-main-key ("quotedbl" :mod-1) 'b-main-focus-workspace-3)
+(define-main-key ("quoteright" :mod-1) 'b-main-focus-workspace-4)
+(define-main-key ("parenleft" :mod-1) 'b-main-focus-workspace-5)
+(define-main-key ("minus" :mod-1) 'b-main-focus-workspace-6)
+(define-main-key ("egrave" :mod-1) 'b-main-focus-workspace-7)
+(define-main-key ("underscore" :mod-1) 'b-main-focus-workspace-8)
+(define-main-key ("ccedilla" :mod-1) 'b-main-focus-workspace-9)
+(define-main-key ("agrave" :mod-1) 'b-main-focus-workspace-10)
+
+;; Second mode
+(undefine-second-multi-keys (#\t) (#\b) (#\b :mod-1)
+ (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
+ (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
+ (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1)
+ (#\1 :control :mod-1) (#\2 :control :mod-1))
+
+(define-second-key (#\<) 'leave-second-mode-maximize)
+
+
+(define-second-key ("ampersand" :mod-1) 'b-second-focus-workspace-1)
+(define-second-key ("eacute" :mod-1) 'b-second-focus-workspace-2)
+(define-second-key ("quotedbl" :mod-1) 'b-second-focus-workspace-3)
+(define-second-key ("quoteright" :mod-1) 'b-second-focus-workspace-4)
+(define-second-key ("parenleft" :mod-1) 'b-second-focus-workspace-5)
+(define-second-key ("minus" :mod-1) 'b-second-focus-workspace-6)
+(define-second-key ("egrave" :mod-1) 'b-second-focus-workspace-7)
+(define-second-key ("underscore" :mod-1) 'b-second-focus-workspace-8)
+(define-second-key ("ccedilla" :mod-1) 'b-second-focus-workspace-9)
+(define-second-key ("agrave" :mod-1) 'b-second-focus-workspace-10)
+
+(define-second-key ("ampersand" :control :mod-1) 'renumber-workspaces)
+(define-second-key ("eacute" :control :mod-1) 'sort-workspaces)
+
+
+(define-second-key ("twosuperior") 'banish-pointer)
+(define-second-key ("twosuperior" :mod-1) 'toggle-maximize-current-group)
+
+(define-second-key (#\t) 'tile-current-workspace-vertically)
+(define-second-key (#\t :shift) 'tile-current-workspace-horizontally)
+
+
+;; Pager mode
+(undefine-pager-multi-keys (#\b)
+ (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
+ (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
+ (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1)
+ (#\1 :control :mod-1) (#\2 :control :mod-1))
+
+(define-pager-key ("twosuperior") 'banish-pointer)
+
+(define-pager-key ("ampersand" :mod-1) 'b-pager-focus-workspace-1)
+(define-pager-key ("eacute" :mod-1) 'b-pager-focus-workspace-2)
+(define-pager-key ("quotedbl" :mod-1) 'b-pager-focus-workspace-3)
+(define-pager-key ("quoteright" :mod-1) 'b-pager-focus-workspace-4)
+(define-pager-key ("parenleft" :mod-1) 'b-pager-focus-workspace-5)
+(define-pager-key ("minus" :mod-1) 'b-pager-focus-workspace-6)
+(define-pager-key ("egrave" :mod-1) 'b-pager-focus-workspace-7)
+(define-pager-key ("underscore" :mod-1) 'b-pager-focus-workspace-8)
+(define-pager-key ("ccedilla" :mod-1) 'b-pager-focus-workspace-9)
+(define-pager-key ("agrave" :mod-1) 'b-pager-focus-workspace-10)
+
+(define-pager-key ("ampersand" :control :mod-1) 'pager-renumber-workspaces)
+(define-pager-key ("eacute" :control :mod-1) 'pager-sort-workspaces)
+
+;;; -- Azerty configuration end --
+
+
+
Added: clfswm/keys.html
==============================================================================
--- (empty file)
+++ clfswm/keys.html Sat Mar 1 07:49:46 2008
@@ -0,0 +1,2576 @@
+<html>
+ <head>
+ <title>
+ CLFSWM Keys
+ </title>
+ </head>
+ <body>
+ <h1>
+ CLFSWM Keys
+ </h1>
+ <p>
+ <small>
+ Note: Mod-1 is the Meta or Alt key
+ </small>
+ </p>
+ <h3>
+ <u>
+ Main mode keys
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 0
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 10
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 9
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 9
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 8
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 8
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 7
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 7
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 6
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 6
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 5
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 4
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 3
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 2
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 1
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace copying current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace moving current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace copying current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace moving current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group copying the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group moving the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group copying the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group moving the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Unhide all hidden windows into the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Destroy the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Delete the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ B
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Maximize/minimize the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ B
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the pointer to the lower right corner of the screen and redraw all groups
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate down windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate up windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Less
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Switch to editing mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Switch to editing mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Home
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Quit clfswm
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ F1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the help and info window
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Second mode keys
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move, pack, fill or resize group left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move, pack, fill or resize group right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move, pack, fill or resize group down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move, pack, fill or resize group up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ M
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Center the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ L
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize down the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ L
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize down the current group to its minimal size
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ R
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group to its half width or heigth on next arraw action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group horizontally
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group vertically
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group in all directions
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group on next arrow action (fill in all directions on second f keypress)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ P
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Pack group on next arrow action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move all windows in the current workspace to one group and remove other groups
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new group for each window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Reconfigure the workspace tiling for the current session
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace with the current window on one side and others on the other
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace horizontally
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace vertically
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ D
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Show debuging info
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ A
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Force the current window to move in the group (Useful only for transient windows)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ A
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Force the current window to move in the center of the group (Useful only for transient windows)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ H
+ </td>
+ <td style="color:#0000ff" nowrap>
+ start an xclock
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ E
+ </td>
+ <td style="color:#0000ff" nowrap>
+ start an emacs for another user
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ E
+ </td>
+ <td style="color:#0000ff" nowrap>
+ start emacs
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ C
+ </td>
+ <td style="color:#0000ff" nowrap>
+ start an xterm
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ O
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open each next window in a new group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ O
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the next window in a new group and all others in the same group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ O
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the next window in a numbered workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ O
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the next window in a new workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ W
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ W
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new default workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current group in the current workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new default group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ K
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ K
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Destroy the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ X
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the fullscreen pager
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ B
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Maximize/minimize the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ B
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the pointer to the lower right corner of the screen and redraw all groups
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate down windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate up windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Sort workspaces by numbers
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Reset workspaces numbers (1 for current workspace, 2 for the second...)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 0
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 10
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 9
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 9
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 8
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 8
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 7
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 7
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 6
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 6
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 5
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 4
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 3
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 2
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 1
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace copying current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace moving current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace copying current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace moving current group in the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group copying the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group moving the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group copying the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group moving the current window in the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Unhide all hidden windows into the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Destroy the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Delete the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Return
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ <
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Return
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode and maximize current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode and maximize current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ !
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Run a program from the query input
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ :
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Eval a lisp form from the query input
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ I
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Identify a key
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Stop all pending actions (actions like open in new workspace/group)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ F1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the help and info window
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Mouse buttons actions in second mode
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Motion
+ </td>
+ <td style="color:#0000ff" nowrap>
+
+Move or resize group. Move window from a group to another.
+Go to top left or rigth corner to change workspaces.
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate down in workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Circulate up in workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate window down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate window up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy selected window
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move selected window
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave second mode and maximize current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy selected group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize selected group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move selected group or create a new group on the root window
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Pager mode keys
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Sort workspaces by numbers
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Reset workspaces numbers (1 for current workspace, 2 for the second...)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 0
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 10
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 9
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 9
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 8
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 8
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 7
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 7
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 6
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 6
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 5
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 4
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 3
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 2
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Focus workspace 1
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy the current group to the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy the current group to the previous workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the current window to the previous line
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the current window to the next line
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the current group to the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the current group to the previous workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move group left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move group right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move group down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move group up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ M
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Center the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move cursor, pack, fill or resize group left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move cursor, pack, fill or resize group right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move cursor, pack, fill or resize group down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move cursor, pack, fill or resize group up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ L
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize down the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ L
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize down the current group to its minimal size
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group horizontally
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group vertically
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group in all directions
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ F
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Fill group on next arrow action (fill in all directions on second f keypress)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ R
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group on next arrow action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ R
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Resize group to its half width or heigth on next arrow action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ M
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move group on next arrow action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ P
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Pack group on next arrow action
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move all windows in the current workspace to one group and remove other groups
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new group for each window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Y
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace with the current window on one side and others on the other
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace horizontally
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ T
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Tile the current workspace vertically
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ X
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Swap the current window with the next window
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ X
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Swap the current group with the next group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ X
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Swap the current workspace with the next workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ W
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ W
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new default workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current group in the current workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Create a new default group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Unhide all hidden windows into the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Remove the current window in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Destroy the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control Shift
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Delete the current window in all groups and workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1 Shift
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate down windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate up windows in the current group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ End
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Select the last workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Home
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Select the first workspace
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ B
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the pointer to the lower right corner of the screen and redraw all groups
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the pager mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Return
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the pager mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ G
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Stop all pending actions (actions like open in new workspace/group)
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ F1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the help and info window
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Mouse buttons actions in pager mode
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Motion
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Select workspaces
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate down windows in selected group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Rotate up windows in selected group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy selected window
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 3
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move selected window
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the pager mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Control
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Copy selected group
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move selected group
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Info mode keys
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Page_up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move ten lines up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Page_down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move ten lines down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ End
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move to last line
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Home
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move to first line
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Right
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one char right
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Left
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one char left
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Up
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one line up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Down
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one line down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Twosuperior
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move the pointer to the lower right corner of the screen
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the info mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Escape
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the info mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Return
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the info mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Q
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the info mode
+ </td>
+ </tr>
+ </table>
+ <h3>
+ <u>
+ Mouse buttons actions in info mode
+ </u>
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <th align="right" width="10%">
+ Modifiers
+ </th>
+ <th align="center" width="10%">
+ Key/Button
+ </th>
+ <th align="left">
+ Function
+ </th>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ Motion
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Grab text
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 5
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one line down
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 4
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Move one line up
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Leave the info mode
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 1
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Begin grab text
+ </td>
+ </tr>
+ </table>
+ </body>
+</html>
Added: clfswm/keys.txt
==============================================================================
--- (empty file)
+++ clfswm/keys.txt Sat Mar 1 07:49:46 2008
@@ -0,0 +1,262 @@
+ * CLFSWM Keys *
+ -----------
+
+Note: Mod-1 is the Meta or Alt key
+
+Main mode keys:
+--------------
+
+Mod-1 0 Focus workspace 10
+Mod-1 9 Focus workspace 9
+Mod-1 8 Focus workspace 8
+Mod-1 7 Focus workspace 7
+Mod-1 6 Focus workspace 6
+Mod-1 5 Focus workspace 5
+Mod-1 4 Focus workspace 4
+Mod-1 3 Focus workspace 3
+Mod-1 2 Focus workspace 2
+Mod-1 1 Focus workspace 1
+Mod-1 Control Shift Left Circulate down in workspace copying current group in the next workspace
+Mod-1 Shift Left Circulate down in workspace moving current group in the next workspace
+Mod-1 Left Circulate down in workspace
+Mod-1 Control Shift Right Circulate up in workspace copying current group in the next workspace
+Mod-1 Shift Right Circulate up in workspace moving current group in the next workspace
+Mod-1 Right Circulate up in workspace
+Mod-1 Control Shift Down Circulate down in group copying the current window in the next group
+Mod-1 Shift Down Circulate down in group moving the current window in the next group
+Mod-1 Down Circulate down in group
+Mod-1 Control Shift Up Circulate up in group copying the current window in the next group
+Mod-1 Shift Up Circulate up in group moving the current window in the next group
+Mod-1 Up Circulate up in group
+Shift Escape Unhide all hidden windows into the current group
+Control Escape Remove the current window in the current group
+Mod-1 Control Shift Escape Destroy the current window in all groups and workspaces
+Control Shift Escape Delete the current window in all groups and workspaces
+Mod-1 Control B Maximize/minimize the current group
+Mod-1 B Move the pointer to the lower right corner of the screen and redraw all groups
+Mod-1 Shift Tab Rotate down windows in the current group
+Mod-1 Tab Rotate up windows in the current group
+Control Less Switch to editing mode
+Mod-1 T Switch to editing mode
+Mod-1 Control Shift Home Quit clfswm
+Mod-1 F1 Open the help and info window
+
+
+Second mode keys:
+----------------
+
+Shift Left Resize group left
+Shift Right Resize group right
+Shift Down Resize group down
+Shift Up Resize group up
+ Left Move, pack, fill or resize group left
+ Right Move, pack, fill or resize group right
+ Down Move, pack, fill or resize group down
+ Up Move, pack, fill or resize group up
+ M Center the current group
+Mod-1 L Resize down the current group
+ L Resize down the current group to its minimal size
+ R Resize group to its half width or heigth on next arraw action
+Control F Fill group horizontally
+Shift F Fill group vertically
+Mod-1 F Fill group in all directions
+ F Fill group on next arrow action (fill in all directions on second f keypress)
+ P Pack group on next arrow action
+Control Shift Y Move all windows in the current workspace to one group and remove other groups
+Control Y Create a new group for each window in the current group
+Mod-1 Y Reconfigure the workspace tiling for the current session
+ Y Tile the current workspace with the current window on one side and others on the other
+Control Shift T Tile the current workspace horizontally
+Control T Tile the current workspace vertically
+Mod-1 D Show debuging info
+Mod-1 A Force the current window to move in the group (Useful only for transient windows)
+ A Force the current window to move in the center of the group (Useful only for transient windows)
+ H start an xclock
+Control E start an emacs for another user
+ E start emacs
+ C start an xterm
+Mod-1 Control O Open each next window in a new group
+Mod-1 O Open the next window in a new group and all others in the same group
+Control O Open the next window in a numbered workspace
+ O Open the next window in a new workspace
+Mod-1 W Remove the current workspace
+ W Create a new default workspace
+Mod-1 G Remove the current group in the current workspace
+ G Create a new default group
+ K Remove the current window in the current group
+Mod-1 K Destroy the current window in all groups and workspaces
+ X Open the fullscreen pager
+Mod-1 B Maximize/minimize the current group
+ B Move the pointer to the lower right corner of the screen and redraw all groups
+Mod-1 Shift Tab Rotate down windows in the current group
+Mod-1 Tab Rotate up windows in the current group
+Mod-1 Control 2 Sort workspaces by numbers
+Mod-1 Control 1 Reset workspaces numbers (1 for current workspace, 2 for the second...)
+Mod-1 0 Focus workspace 10
+Mod-1 9 Focus workspace 9
+Mod-1 8 Focus workspace 8
+Mod-1 7 Focus workspace 7
+Mod-1 6 Focus workspace 6
+Mod-1 5 Focus workspace 5
+Mod-1 4 Focus workspace 4
+Mod-1 3 Focus workspace 3
+Mod-1 2 Focus workspace 2
+Mod-1 1 Focus workspace 1
+Mod-1 Control Shift Left Circulate down in workspace copying current group in the next workspace
+Mod-1 Shift Left Circulate down in workspace moving current group in the next workspace
+Mod-1 Left Circulate down in workspace
+Mod-1 Control Shift Right Circulate up in workspace copying current group in the next workspace
+Mod-1 Shift Right Circulate up in workspace moving current group in the next workspace
+Mod-1 Right Circulate up in workspace
+Mod-1 Control Shift Down Circulate down in group copying the current window in the next group
+Mod-1 Shift Down Circulate down in group moving the current window in the next group
+Mod-1 Down Circulate down in group
+Mod-1 Control Shift Up Circulate up in group copying the current window in the next group
+Mod-1 Shift Up Circulate up in group moving the current window in the next group
+Mod-1 Up Circulate up in group
+Shift Escape Unhide all hidden windows into the current group
+Control Escape Remove the current window in the current group
+Mod-1 Control Shift Escape Destroy the current window in all groups and workspaces
+Control Shift Escape Delete the current window in all groups and workspaces
+Control Return Leave second mode
+Control < Leave second mode
+ Escape Leave second mode
+ Return Leave second mode and maximize current group
+ T Leave second mode and maximize current group
+ ! Run a program from the query input
+ : Eval a lisp form from the query input
+ I Identify a key
+Control G Stop all pending actions (actions like open in new workspace/group)
+Mod-1 F1 Open the help and info window
+
+
+Mouse buttons actions in second mode:
+------------------------------------
+
+ Motion
+Move or resize group. Move window from a group to another.
+Go to top left or rigth corner to change workspaces.
+Mod-1 5 Circulate down in workspaces
+Mod-1 4 Circulate up in workspaces
+ 5 Rotate window down
+ 4 Rotate window up
+Control 3 Copy selected window
+ 3 Move selected window
+Control 2 Leave second mode
+ 2 Leave second mode and maximize current group
+Control 1 Copy selected group
+Mod-1 1 Resize selected group
+ 1 Move selected group or create a new group on the root window
+
+
+Pager mode keys:
+---------------
+
+Mod-1 Control 2 Sort workspaces by numbers
+Mod-1 Control 1 Reset workspaces numbers (1 for current workspace, 2 for the second...)
+Mod-1 0 Focus workspace 10
+Mod-1 9 Focus workspace 9
+Mod-1 8 Focus workspace 8
+Mod-1 7 Focus workspace 7
+Mod-1 6 Focus workspace 6
+Mod-1 5 Focus workspace 5
+Mod-1 4 Focus workspace 4
+Mod-1 3 Focus workspace 3
+Mod-1 2 Focus workspace 2
+Mod-1 1 Focus workspace 1
+Control Shift Right Copy the current group to the next workspace
+Control Shift Left Copy the current group to the previous workspace
+Shift Up Move the current window to the previous line
+Shift Down Move the current window to the next line
+Shift Right Move the current group to the next workspace
+Shift Left Move the current group to the previous workspace
+Mod-1 Control Left Resize group left
+Mod-1 Control Right Resize group right
+Mod-1 Control Down Resize group down
+Mod-1 Control Up Resize group up
+Mod-1 Left Move group left
+Mod-1 Right Move group right
+Mod-1 Down Move group down
+Mod-1 Up Move group up
+ M Center the current group
+ Left Move cursor, pack, fill or resize group left
+ Right Move cursor, pack, fill or resize group right
+ Down Move cursor, pack, fill or resize group down
+ Up Move cursor, pack, fill or resize group up
+Mod-1 L Resize down the current group
+ L Resize down the current group to its minimal size
+Control F Fill group horizontally
+Shift F Fill group vertically
+Mod-1 F Fill group in all directions
+ F Fill group on next arrow action (fill in all directions on second f keypress)
+Shift R Resize group on next arrow action
+ R Resize group to its half width or heigth on next arrow action
+Shift M Move group on next arrow action
+ P Pack group on next arrow action
+Control Shift Y Move all windows in the current workspace to one group and remove other groups
+Control Y Create a new group for each window in the current group
+ Y Tile the current workspace with the current window on one side and others on the other
+Shift T Tile the current workspace horizontally
+ T Tile the current workspace vertically
+Mod-1 X Swap the current window with the next window
+Control X Swap the current group with the next group
+ X Swap the current workspace with the next workspace
+Mod-1 W Remove the current workspace
+ W Create a new default workspace
+Mod-1 G Remove the current group in the current workspace
+ G Create a new default group
+Shift Escape Unhide all hidden windows into the current group
+Control Escape Remove the current window in the current group
+Mod-1 Control Shift Escape Destroy the current window in all groups and workspaces
+Control Shift Escape Delete the current window in all groups and workspaces
+Mod-1 Shift Tab Rotate down windows in the current group
+Mod-1 Tab Rotate up windows in the current group
+ End Select the last workspace
+ Home Select the first workspace
+ B Move the pointer to the lower right corner of the screen and redraw all groups
+ Escape Leave the pager mode
+ Return Leave the pager mode
+Control G Stop all pending actions (actions like open in new workspace/group)
+Mod-1 F1 Open the help and info window
+
+
+Mouse buttons actions in pager mode:
+-----------------------------------
+
+ Motion Select workspaces
+ 5 Rotate down windows in selected group
+ 4 Rotate up windows in selected group
+Control 3 Copy selected window
+ 3 Move selected window
+ 2 Leave the pager mode
+Control 1 Copy selected group
+ 1 Move selected group
+
+
+Info mode keys:
+--------------
+
+ Page_up Move ten lines up
+ Page_down Move ten lines down
+ End Move to last line
+ Home Move to first line
+ Right Move one char right
+ Left Move one char left
+ Up Move one line up
+ Down Move one line down
+ Twosuperior Move the pointer to the lower right corner of the screen
+ Leave the info mode
+ Escape Leave the info mode
+ Return Leave the info mode
+ Q Leave the info mode
+
+
+Mouse buttons actions in info mode:
+----------------------------------
+
+ Motion Grab text
+ 5 Move one line down
+ 4 Move one line up
+ 2 Leave the info mode
+ 1 Begin grab text
+
Added: clfswm/keysyms.lisp
==============================================================================
--- (empty file)
+++ clfswm/keysyms.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,1759 @@
+;; Copyright (C) 2006 Matthew Kennedy
+;;
+;; This file is part of stumpwm.
+;;
+;; stumpwm 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 2, or (at your option)
+;; any later version.
+
+;; stumpwm 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 software; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+;; Commentary:
+;;
+;; Mapping a keysym to a name is a client side activity in X11. Some
+;; of the code here was taken from the CMUCL Hemlocks code base. The
+;; actual mappings were taken from Xorg's keysymdefs.h.
+;;
+;; Code:
+
+(in-package :clfswm)
+
+(defvar *keysym-name-translations* (make-hash-table))
+(defvar *name-keysym-translations* (make-hash-table :test #'equal))
+
+(defun cl-define-keysym (keysym name)
+ "Define a mapping from a keysym name to a keysym."
+ (setf (gethash keysym *keysym-name-translations*) name
+ (gethash name *name-keysym-translations*) keysym))
+
+(defun keysym-name->keysym (name)
+ "Return the keysym corresponding to NAME."
+ (multiple-value-bind (value present-p)
+ (gethash name *name-keysym-translations*)
+ (declare (ignore present-p))
+ value))
+
+(defun keysym->keysym-name (keysym)
+ "Return the name corresponding to KEYSYM."
+ (multiple-value-bind (value present-p)
+ (gethash keysym *keysym-name-translations*)
+ (declare (ignore present-p))
+ value))
+
+(cl-define-keysym #xffffff "VoidSymbol") ;Void symbol
+(cl-define-keysym #xff08 "BackSpace") ;Back space, back char
+(cl-define-keysym #xff09 "Tab")
+(cl-define-keysym #xff0a "Linefeed") ;Linefeed, LF
+(cl-define-keysym #xff0b "Clear")
+(cl-define-keysym #xff0d "Return") ;Return, enter
+(cl-define-keysym #xff13 "Pause") ;Pause, hold
+(cl-define-keysym #xff14 "Scroll_Lock")
+(cl-define-keysym #xff15 "Sys_Req")
+(cl-define-keysym #xff1b "Escape")
+(cl-define-keysym #xffff "Delete") ;Delete, rubout
+(cl-define-keysym #xff20 "Multi_key") ;Multi-key character compose
+(cl-define-keysym #xff37 "Codeinput")
+(cl-define-keysym #xff3c "SingleCandidate")
+(cl-define-keysym #xff3d "MultipleCandidate")
+(cl-define-keysym #xff3e "PreviousCandidate")
+(cl-define-keysym #xff21 "Kanji") ;Kanji, Kanji convert
+(cl-define-keysym #xff22 "Muhenkan") ;Cancel Conversion
+(cl-define-keysym #xff23 "Henkan_Mode") ;Start/Stop Conversion
+(cl-define-keysym #xff23 "Henkan") ;Alias for Henkan_Mode
+(cl-define-keysym #xff24 "Romaji") ;to Romaji
+(cl-define-keysym #xff25 "Hiragana") ;to Hiragana
+(cl-define-keysym #xff26 "Katakana") ;to Katakana
+(cl-define-keysym #xff27 "Hiragana_Katakana") ;Hiragana/Katakana toggle
+(cl-define-keysym #xff28 "Zenkaku") ;to Zenkaku
+(cl-define-keysym #xff29 "Hankaku") ;to Hankaku
+(cl-define-keysym #xff2a "Zenkaku_Hankaku") ;Zenkaku/Hankaku toggle
+(cl-define-keysym #xff2b "Touroku") ;Add to Dictionary
+(cl-define-keysym #xff2c "Massyo") ;Delete from Dictionary
+(cl-define-keysym #xff2d "Kana_Lock") ;Kana Lock
+(cl-define-keysym #xff2e "Kana_Shift") ;Kana Shift
+(cl-define-keysym #xff2f "Eisu_Shift") ;Alphanumeric Shift
+(cl-define-keysym #xff30 "Eisu_toggle") ;Alphanumeric toggle
+(cl-define-keysym #xff37 "Kanji_Bangou") ;Codeinput
+(cl-define-keysym #xff3d "Zen_Koho") ;Multiple/All Candidate(s)
+(cl-define-keysym #xff3e "Mae_Koho") ;Previous Candidate
+(cl-define-keysym #xff50 "Home")
+(cl-define-keysym #xff51 "Left") ;Move left, left arrow
+(cl-define-keysym #xff52 "Up") ;Move up, up arrow
+(cl-define-keysym #xff53 "Right") ;Move right, right arrow
+(cl-define-keysym #xff54 "Down") ;Move down, down arrow
+(cl-define-keysym #xff55 "Prior") ;Prior, previous
+(cl-define-keysym #xff55 "Page_Up")
+(cl-define-keysym #xff56 "Next") ;Next
+(cl-define-keysym #xff56 "Page_Down")
+(cl-define-keysym #xff57 "End") ;EOL
+(cl-define-keysym #xff58 "Begin") ;BOL
+(cl-define-keysym #xff60 "Select") ;Select, mark
+(cl-define-keysym #xff61 "Print")
+(cl-define-keysym #xff62 "Execute") ;Execute, run, do
+(cl-define-keysym #xff63 "Insert") ;Insert, insert here
+(cl-define-keysym #xff65 "Undo")
+(cl-define-keysym #xff66 "Redo") ;Redo, again
+(cl-define-keysym #xff67 "Menu")
+(cl-define-keysym #xff68 "Find") ;Find, search
+(cl-define-keysym #xff69 "Cancel") ;Cancel, stop, abort, exit
+(cl-define-keysym #xff6a "Help") ;Help
+(cl-define-keysym #xff6b "Break")
+(cl-define-keysym #xff7e "Mode_switch") ;Character set switch
+(cl-define-keysym #xff7e "script_switch") ;Alias for mode_switch
+(cl-define-keysym #xff7f "Num_Lock")
+(cl-define-keysym #xff80 "KP_Space") ;Space
+(cl-define-keysym #xff89 "KP_Tab")
+(cl-define-keysym #xff8d "KP_Enter") ;Enter
+(cl-define-keysym #xff91 "KP_F1") ;PF1, KP_A, ...
+(cl-define-keysym #xff92 "KP_F2")
+(cl-define-keysym #xff93 "KP_F3")
+(cl-define-keysym #xff94 "KP_F4")
+(cl-define-keysym #xff95 "KP_Home")
+(cl-define-keysym #xff96 "KP_Left")
+(cl-define-keysym #xff97 "KP_Up")
+(cl-define-keysym #xff98 "KP_Right")
+(cl-define-keysym #xff99 "KP_Down")
+(cl-define-keysym #xff9a "KP_Prior")
+(cl-define-keysym #xff9a "KP_Page_Up")
+(cl-define-keysym #xff9b "KP_Next")
+(cl-define-keysym #xff9b "KP_Page_Down")
+(cl-define-keysym #xff9c "KP_End")
+(cl-define-keysym #xff9d "KP_Begin")
+(cl-define-keysym #xff9e "KP_Insert")
+(cl-define-keysym #xff9f "KP_Delete")
+(cl-define-keysym #xffbd "KP_Equal") ;Equals
+(cl-define-keysym #xffaa "KP_Multiply")
+(cl-define-keysym #xffab "KP_Add")
+(cl-define-keysym #xffac "KP_Separator") ;Separator, often comma
+(cl-define-keysym #xffad "KP_Subtract")
+(cl-define-keysym #xffae "KP_Decimal")
+(cl-define-keysym #xffaf "KP_Divide")
+(cl-define-keysym #xffb0 "KP_0")
+(cl-define-keysym #xffb1 "KP_1")
+(cl-define-keysym #xffb2 "KP_2")
+(cl-define-keysym #xffb3 "KP_3")
+(cl-define-keysym #xffb4 "KP_4")
+(cl-define-keysym #xffb5 "KP_5")
+(cl-define-keysym #xffb6 "KP_6")
+(cl-define-keysym #xffb7 "KP_7")
+(cl-define-keysym #xffb8 "KP_8")
+(cl-define-keysym #xffb9 "KP_9")
+(cl-define-keysym #xffbe "F1")
+(cl-define-keysym #xffbf "F2")
+(cl-define-keysym #xffc0 "F3")
+(cl-define-keysym #xffc1 "F4")
+(cl-define-keysym #xffc2 "F5")
+(cl-define-keysym #xffc3 "F6")
+(cl-define-keysym #xffc4 "F7")
+(cl-define-keysym #xffc5 "F8")
+(cl-define-keysym #xffc6 "F9")
+(cl-define-keysym #xffc7 "F10")
+(cl-define-keysym #xffc8 "F11")
+(cl-define-keysym #xffc8 "L1")
+(cl-define-keysym #xffc9 "F12")
+(cl-define-keysym #xffc9 "L2")
+(cl-define-keysym #xffca "F13")
+(cl-define-keysym #xffca "L3")
+(cl-define-keysym #xffcb "F14")
+(cl-define-keysym #xffcb "L4")
+(cl-define-keysym #xffcc "F15")
+(cl-define-keysym #xffcc "L5")
+(cl-define-keysym #xffcd "F16")
+(cl-define-keysym #xffcd "L6")
+(cl-define-keysym #xffce "F17")
+(cl-define-keysym #xffce "L7")
+(cl-define-keysym #xffcf "F18")
+(cl-define-keysym #xffcf "L8")
+(cl-define-keysym #xffd0 "F19")
+(cl-define-keysym #xffd0 "L9")
+(cl-define-keysym #xffd1 "F20")
+(cl-define-keysym #xffd1 "L10")
+(cl-define-keysym #xffd2 "F21")
+(cl-define-keysym #xffd2 "R1")
+(cl-define-keysym #xffd3 "F22")
+(cl-define-keysym #xffd3 "R2")
+(cl-define-keysym #xffd4 "F23")
+(cl-define-keysym #xffd4 "R3")
+(cl-define-keysym #xffd5 "F24")
+(cl-define-keysym #xffd5 "R4")
+(cl-define-keysym #xffd6 "F25")
+(cl-define-keysym #xffd6 "R5")
+(cl-define-keysym #xffd7 "F26")
+(cl-define-keysym #xffd7 "R6")
+(cl-define-keysym #xffd8 "F27")
+(cl-define-keysym #xffd8 "R7")
+(cl-define-keysym #xffd9 "F28")
+(cl-define-keysym #xffd9 "R8")
+(cl-define-keysym #xffda "F29")
+(cl-define-keysym #xffda "R9")
+(cl-define-keysym #xffdb "F30")
+(cl-define-keysym #xffdb "R10")
+(cl-define-keysym #xffdc "F31")
+(cl-define-keysym #xffdc "R11")
+(cl-define-keysym #xffdd "F32")
+(cl-define-keysym #xffdd "R12")
+(cl-define-keysym #xffde "F33")
+(cl-define-keysym #xffde "R13")
+(cl-define-keysym #xffdf "F34")
+(cl-define-keysym #xffdf "R14")
+(cl-define-keysym #xffe0 "F35")
+(cl-define-keysym #xffe0 "R15")
+(cl-define-keysym #xffe1 "Shift_L") ;Left shift
+(cl-define-keysym #xffe2 "Shift_R") ;Right shift
+(cl-define-keysym #xffe3 "Control_L") ;Left control
+(cl-define-keysym #xffe4 "Control_R") ;Right control
+(cl-define-keysym #xffe5 "Caps_Lock") ;Caps lock
+(cl-define-keysym #xffe6 "Shift_Lock") ;Shift lock
+(cl-define-keysym #xffe7 "Meta_L") ;Left meta
+(cl-define-keysym #xffe8 "Meta_R") ;Right meta
+(cl-define-keysym #xffe9 "Alt_L") ;Left alt
+(cl-define-keysym #xffea "Alt_R") ;Right alt
+(cl-define-keysym #xffeb "Super_L") ;Left super
+(cl-define-keysym #xffec "Super_R") ;Right super
+(cl-define-keysym #xffed "Hyper_L") ;Left hyper
+(cl-define-keysym #xffee "Hyper_R") ;Right hyper
+(cl-define-keysym #xfe01 "ISO_Lock")
+(cl-define-keysym #xfe02 "ISO_Level2_Latch")
+(cl-define-keysym #xfe03 "ISO_Level3_Shift")
+(cl-define-keysym #xfe04 "ISO_Level3_Latch")
+(cl-define-keysym #xfe05 "ISO_Level3_Lock")
+(cl-define-keysym #xff7e "ISO_Group_Shift") ;Alias for mode_switch
+(cl-define-keysym #xfe06 "ISO_Group_Latch")
+(cl-define-keysym #xfe07 "ISO_Group_Lock")
+(cl-define-keysym #xfe08 "ISO_Next_Group")
+(cl-define-keysym #xfe09 "ISO_Next_Group_Lock")
+(cl-define-keysym #xfe0a "ISO_Prev_Group")
+(cl-define-keysym #xfe0b "ISO_Prev_Group_Lock")
+(cl-define-keysym #xfe0c "ISO_First_Group")
+(cl-define-keysym #xfe0d "ISO_First_Group_Lock")
+(cl-define-keysym #xfe0e "ISO_Last_Group")
+(cl-define-keysym #xfe0f "ISO_Last_Group_Lock")
+(cl-define-keysym #xfe20 "ISO_Left_Tab")
+(cl-define-keysym #xfe21 "ISO_Move_Line_Up")
+(cl-define-keysym #xfe22 "ISO_Move_Line_Down")
+(cl-define-keysym #xfe23 "ISO_Partial_Line_Up")
+(cl-define-keysym #xfe24 "ISO_Partial_Line_Down")
+(cl-define-keysym #xfe25 "ISO_Partial_Space_Left")
+(cl-define-keysym #xfe26 "ISO_Partial_Space_Right")
+(cl-define-keysym #xfe27 "ISO_Set_Margin_Left")
+(cl-define-keysym #xfe28 "ISO_Set_Margin_Right")
+(cl-define-keysym #xfe29 "ISO_Release_Margin_Left")
+(cl-define-keysym #xfe2a "ISO_Release_Margin_Right")
+(cl-define-keysym #xfe2b "ISO_Release_Both_Margins")
+(cl-define-keysym #xfe2c "ISO_Fast_Cursor_Left")
+(cl-define-keysym #xfe2d "ISO_Fast_Cursor_Right")
+(cl-define-keysym #xfe2e "ISO_Fast_Cursor_Up")
+(cl-define-keysym #xfe2f "ISO_Fast_Cursor_Down")
+(cl-define-keysym #xfe30 "ISO_Continuous_Underline")
+(cl-define-keysym #xfe31 "ISO_Discontinuous_Underline")
+(cl-define-keysym #xfe32 "ISO_Emphasize")
+(cl-define-keysym #xfe33 "ISO_Center_Object")
+(cl-define-keysym #xfe34 "ISO_Enter")
+(cl-define-keysym #xfe50 "dead_grave")
+(cl-define-keysym #xfe51 "dead_acute")
+(cl-define-keysym #xfe52 "dead_circumflex")
+(cl-define-keysym #xfe53 "dead_tilde")
+(cl-define-keysym #xfe54 "dead_macron")
+(cl-define-keysym #xfe55 "dead_breve")
+(cl-define-keysym #xfe56 "dead_abovedot")
+(cl-define-keysym #xfe57 "dead_diaeresis")
+(cl-define-keysym #xfe58 "dead_abovering")
+(cl-define-keysym #xfe59 "dead_doubleacute")
+(cl-define-keysym #xfe5a "dead_caron")
+(cl-define-keysym #xfe5b "dead_cedilla")
+(cl-define-keysym #xfe5c "dead_ogonek")
+(cl-define-keysym #xfe5d "dead_iota")
+(cl-define-keysym #xfe5e "dead_voiced_sound")
+(cl-define-keysym #xfe5f "dead_semivoiced_sound")
+(cl-define-keysym #xfe60 "dead_belowdot")
+(cl-define-keysym #xfe61 "dead_hook")
+(cl-define-keysym #xfe62 "dead_horn")
+(cl-define-keysym #xfed0 "First_Virtual_Screen")
+(cl-define-keysym #xfed1 "Prev_Virtual_Screen")
+(cl-define-keysym #xfed2 "Next_Virtual_Screen")
+(cl-define-keysym #xfed4 "Last_Virtual_Screen")
+(cl-define-keysym #xfed5 "Terminate_Server")
+(cl-define-keysym #xfe70 "AccessX_Enable")
+(cl-define-keysym #xfe71 "AccessX_Feedback_Enable")
+(cl-define-keysym #xfe72 "RepeatKeys_Enable")
+(cl-define-keysym #xfe73 "SlowKeys_Enable")
+(cl-define-keysym #xfe74 "BounceKeys_Enable")
+(cl-define-keysym #xfe75 "StickyKeys_Enable")
+(cl-define-keysym #xfe76 "MouseKeys_Enable")
+(cl-define-keysym #xfe77 "MouseKeys_Accel_Enable")
+(cl-define-keysym #xfe78 "Overlay1_Enable")
+(cl-define-keysym #xfe79 "Overlay2_Enable")
+(cl-define-keysym #xfe7a "AudibleBell_Enable")
+(cl-define-keysym #xfee0 "Pointer_Left")
+(cl-define-keysym #xfee1 "Pointer_Right")
+(cl-define-keysym #xfee2 "Pointer_Up")
+(cl-define-keysym #xfee3 "Pointer_Down")
+(cl-define-keysym #xfee4 "Pointer_UpLeft")
+(cl-define-keysym #xfee5 "Pointer_UpRight")
+(cl-define-keysym #xfee6 "Pointer_DownLeft")
+(cl-define-keysym #xfee7 "Pointer_DownRight")
+(cl-define-keysym #xfee8 "Pointer_Button_Dflt")
+(cl-define-keysym #xfee9 "Pointer_Button1")
+(cl-define-keysym #xfeea "Pointer_Button2")
+(cl-define-keysym #xfeeb "Pointer_Button3")
+(cl-define-keysym #xfeec "Pointer_Button4")
+(cl-define-keysym #xfeed "Pointer_Button5")
+(cl-define-keysym #xfeee "Pointer_DblClick_Dflt")
+(cl-define-keysym #xfeef "Pointer_DblClick1")
+(cl-define-keysym #xfef0 "Pointer_DblClick2")
+(cl-define-keysym #xfef1 "Pointer_DblClick3")
+(cl-define-keysym #xfef2 "Pointer_DblClick4")
+(cl-define-keysym #xfef3 "Pointer_DblClick5")
+(cl-define-keysym #xfef4 "Pointer_Drag_Dflt")
+(cl-define-keysym #xfef5 "Pointer_Drag1")
+(cl-define-keysym #xfef6 "Pointer_Drag2")
+(cl-define-keysym #xfef7 "Pointer_Drag3")
+(cl-define-keysym #xfef8 "Pointer_Drag4")
+(cl-define-keysym #xfefd "Pointer_Drag5")
+(cl-define-keysym #xfef9 "Pointer_EnableKeys")
+(cl-define-keysym #xfefa "Pointer_Accelerate")
+(cl-define-keysym #xfefb "Pointer_DfltBtnNext")
+(cl-define-keysym #xfefc "Pointer_DfltBtnPrev")
+(cl-define-keysym #xfd01 "3270_Duplicate")
+(cl-define-keysym #xfd02 "3270_FieldMark")
+(cl-define-keysym #xfd03 "3270_Right2")
+(cl-define-keysym #xfd04 "3270_Left2")
+(cl-define-keysym #xfd05 "3270_BackTab")
+(cl-define-keysym #xfd06 "3270_EraseEOF")
+(cl-define-keysym #xfd07 "3270_EraseInput")
+(cl-define-keysym #xfd08 "3270_Reset")
+(cl-define-keysym #xfd09 "3270_Quit")
+(cl-define-keysym #xfd0a "3270_PA1")
+(cl-define-keysym #xfd0b "3270_PA2")
+(cl-define-keysym #xfd0c "3270_PA3")
+(cl-define-keysym #xfd0d "3270_Test")
+(cl-define-keysym #xfd0e "3270_Attn")
+(cl-define-keysym #xfd0f "3270_CursorBlink")
+(cl-define-keysym #xfd10 "3270_AltCursor")
+(cl-define-keysym #xfd11 "3270_KeyClick")
+(cl-define-keysym #xfd12 "3270_Jump")
+(cl-define-keysym #xfd13 "3270_Ident")
+(cl-define-keysym #xfd14 "3270_Rule")
+(cl-define-keysym #xfd15 "3270_Copy")
+(cl-define-keysym #xfd16 "3270_Play")
+(cl-define-keysym #xfd17 "3270_Setup")
+(cl-define-keysym #xfd18 "3270_Record")
+(cl-define-keysym #xfd19 "3270_ChangeScreen")
+(cl-define-keysym #xfd1a "3270_DeleteWord")
+(cl-define-keysym #xfd1b "3270_ExSelect")
+(cl-define-keysym #xfd1c "3270_CursorSelect")
+(cl-define-keysym #xfd1d "3270_PrintScreen")
+(cl-define-keysym #xfd1e "3270_Enter")
+(cl-define-keysym #x0020 "space") ;U+0020 SPACE
+(cl-define-keysym #x0021 "exclam") ;U+0021 EXCLAMATION MARK
+(cl-define-keysym #x0022 "quotedbl") ;U+0022 QUOTATION MARK
+(cl-define-keysym #x0023 "numbersign") ;U+0023 NUMBER SIGN
+(cl-define-keysym #x0024 "dollar") ;U+0024 DOLLAR SIGN
+(cl-define-keysym #x0025 "percent") ;U+0025 PERCENT SIGN
+(cl-define-keysym #x0026 "ampersand") ;U+0026 AMPERSAND
+(cl-define-keysym #x0027 "apostrophe") ;U+0027 APOSTROPHE
+(cl-define-keysym #x0027 "quoteright") ;deprecated
+(cl-define-keysym #x0028 "parenleft") ;U+0028 LEFT PARENTHESIS
+(cl-define-keysym #x0029 "parenright") ;U+0029 RIGHT PARENTHESIS
+(cl-define-keysym #x002a "asterisk") ;U+002A ASTERISK
+(cl-define-keysym #x002b "plus") ;U+002B PLUS SIGN
+(cl-define-keysym #x002c "comma") ;U+002C COMMA
+(cl-define-keysym #x002d "minus") ;U+002D HYPHEN-MINUS
+(cl-define-keysym #x002e "period") ;U+002E FULL STOP
+(cl-define-keysym #x002f "slash") ;U+002F SOLIDUS
+(cl-define-keysym #x0030 "0") ;U+0030 DIGIT ZERO
+(cl-define-keysym #x0031 "1") ;U+0031 DIGIT ONE
+(cl-define-keysym #x0032 "2") ;U+0032 DIGIT TWO
+(cl-define-keysym #x0033 "3") ;U+0033 DIGIT THREE
+(cl-define-keysym #x0034 "4") ;U+0034 DIGIT FOUR
+(cl-define-keysym #x0035 "5") ;U+0035 DIGIT FIVE
+(cl-define-keysym #x0036 "6") ;U+0036 DIGIT SIX
+(cl-define-keysym #x0037 "7") ;U+0037 DIGIT SEVEN
+(cl-define-keysym #x0038 "8") ;U+0038 DIGIT EIGHT
+(cl-define-keysym #x0039 "9") ;U+0039 DIGIT NINE
+(cl-define-keysym #x003a "colon") ;U+003A COLON
+(cl-define-keysym #x003b "semicolon") ;U+003B SEMICOLON
+(cl-define-keysym #x003c "less") ;U+003C LESS-THAN SIGN
+(cl-define-keysym #x003d "equal") ;U+003D EQUALS SIGN
+(cl-define-keysym #x003e "greater") ;U+003E GREATER-THAN SIGN
+(cl-define-keysym #x003f "question") ;U+003F QUESTION MARK
+(cl-define-keysym #x0040 "at") ;U+0040 COMMERCIAL AT
+(cl-define-keysym #x0041 "A") ;U+0041 LATIN CAPITAL LETTER A
+(cl-define-keysym #x0042 "B") ;U+0042 LATIN CAPITAL LETTER B
+(cl-define-keysym #x0043 "C") ;U+0043 LATIN CAPITAL LETTER C
+(cl-define-keysym #x0044 "D") ;U+0044 LATIN CAPITAL LETTER D
+(cl-define-keysym #x0045 "E") ;U+0045 LATIN CAPITAL LETTER E
+(cl-define-keysym #x0046 "F") ;U+0046 LATIN CAPITAL LETTER F
+(cl-define-keysym #x0047 "G") ;U+0047 LATIN CAPITAL LETTER G
+(cl-define-keysym #x0048 "H") ;U+0048 LATIN CAPITAL LETTER H
+(cl-define-keysym #x0049 "I") ;U+0049 LATIN CAPITAL LETTER I
+(cl-define-keysym #x004a "J") ;U+004A LATIN CAPITAL LETTER J
+(cl-define-keysym #x004b "K") ;U+004B LATIN CAPITAL LETTER K
+(cl-define-keysym #x004c "L") ;U+004C LATIN CAPITAL LETTER L
+(cl-define-keysym #x004d "M") ;U+004D LATIN CAPITAL LETTER M
+(cl-define-keysym #x004e "N") ;U+004E LATIN CAPITAL LETTER N
+(cl-define-keysym #x004f "O") ;U+004F LATIN CAPITAL LETTER O
+(cl-define-keysym #x0050 "P") ;U+0050 LATIN CAPITAL LETTER P
+(cl-define-keysym #x0051 "Q") ;U+0051 LATIN CAPITAL LETTER Q
+(cl-define-keysym #x0052 "R") ;U+0052 LATIN CAPITAL LETTER R
+(cl-define-keysym #x0053 "S") ;U+0053 LATIN CAPITAL LETTER S
+(cl-define-keysym #x0054 "T") ;U+0054 LATIN CAPITAL LETTER T
+(cl-define-keysym #x0055 "U") ;U+0055 LATIN CAPITAL LETTER U
+(cl-define-keysym #x0056 "V") ;U+0056 LATIN CAPITAL LETTER V
+(cl-define-keysym #x0057 "W") ;U+0057 LATIN CAPITAL LETTER W
+(cl-define-keysym #x0058 "X") ;U+0058 LATIN CAPITAL LETTER X
+(cl-define-keysym #x0059 "Y") ;U+0059 LATIN CAPITAL LETTER Y
+(cl-define-keysym #x005a "Z") ;U+005A LATIN CAPITAL LETTER Z
+(cl-define-keysym #x005b "bracketleft") ;U+005B LEFT SQUARE BRACKET
+(cl-define-keysym #x005c "backslash") ;U+005C REVERSE SOLIDUS
+(cl-define-keysym #x005d "bracketright") ;U+005D RIGHT SQUARE BRACKET
+(cl-define-keysym #x005e "asciicircum") ;U+005E CIRCUMFLEX ACCENT
+(cl-define-keysym #x005f "underscore") ;U+005F LOW LINE
+(cl-define-keysym #x0060 "grave") ;U+0060 GRAVE ACCENT
+(cl-define-keysym #x0060 "quoteleft") ;deprecated
+(cl-define-keysym #x0061 "a") ;U+0061 LATIN SMALL LETTER A
+(cl-define-keysym #x0062 "b") ;U+0062 LATIN SMALL LETTER B
+(cl-define-keysym #x0063 "c") ;U+0063 LATIN SMALL LETTER C
+(cl-define-keysym #x0064 "d") ;U+0064 LATIN SMALL LETTER D
+(cl-define-keysym #x0065 "e") ;U+0065 LATIN SMALL LETTER E
+(cl-define-keysym #x0066 "f") ;U+0066 LATIN SMALL LETTER F
+(cl-define-keysym #x0067 "g") ;U+0067 LATIN SMALL LETTER G
+(cl-define-keysym #x0068 "h") ;U+0068 LATIN SMALL LETTER H
+(cl-define-keysym #x0069 "i") ;U+0069 LATIN SMALL LETTER I
+(cl-define-keysym #x006a "j") ;U+006A LATIN SMALL LETTER J
+(cl-define-keysym #x006b "k") ;U+006B LATIN SMALL LETTER K
+(cl-define-keysym #x006c "l") ;U+006C LATIN SMALL LETTER L
+(cl-define-keysym #x006d "m") ;U+006D LATIN SMALL LETTER M
+(cl-define-keysym #x006e "n") ;U+006E LATIN SMALL LETTER N
+(cl-define-keysym #x006f "o") ;U+006F LATIN SMALL LETTER O
+(cl-define-keysym #x0070 "p") ;U+0070 LATIN SMALL LETTER P
+(cl-define-keysym #x0071 "q") ;U+0071 LATIN SMALL LETTER Q
+(cl-define-keysym #x0072 "r") ;U+0072 LATIN SMALL LETTER R
+(cl-define-keysym #x0073 "s") ;U+0073 LATIN SMALL LETTER S
+(cl-define-keysym #x0074 "t") ;U+0074 LATIN SMALL LETTER T
+(cl-define-keysym #x0075 "u") ;U+0075 LATIN SMALL LETTER U
+(cl-define-keysym #x0076 "v") ;U+0076 LATIN SMALL LETTER V
+(cl-define-keysym #x0077 "w") ;U+0077 LATIN SMALL LETTER W
+(cl-define-keysym #x0078 "x") ;U+0078 LATIN SMALL LETTER X
+(cl-define-keysym #x0079 "y") ;U+0079 LATIN SMALL LETTER Y
+(cl-define-keysym #x007a "z") ;U+007A LATIN SMALL LETTER Z
+(cl-define-keysym #x007b "braceleft") ;U+007B LEFT CURLY BRACKET
+(cl-define-keysym #x007c "bar") ;U+007C VERTICAL LINE
+(cl-define-keysym #x007d "braceright") ;U+007D RIGHT CURLY BRACKET
+(cl-define-keysym #x007e "asciitilde") ;U+007E TILDE
+(cl-define-keysym #x00a0 "nobreakspace") ;U+00A0 NO-BREAK SPACE
+(cl-define-keysym #x00a1 "exclamdown") ;U+00A1 INVERTED EXCLAMATION MARK
+(cl-define-keysym #x00a2 "cent") ;U+00A2 CENT SIGN
+(cl-define-keysym #x00a3 "sterling") ;U+00A3 POUND SIGN
+(cl-define-keysym #x00a4 "currency") ;U+00A4 CURRENCY SIGN
+(cl-define-keysym #x00a5 "yen") ;U+00A5 YEN SIGN
+(cl-define-keysym #x00a6 "brokenbar") ;U+00A6 BROKEN BAR
+(cl-define-keysym #x00a7 "section") ;U+00A7 SECTION SIGN
+(cl-define-keysym #x00a8 "diaeresis") ;U+00A8 DIAERESIS
+(cl-define-keysym #x00a9 "copyright") ;U+00A9 COPYRIGHT SIGN
+(cl-define-keysym #x00aa "ordfeminine") ;U+00AA FEMININE ORDINAL INDICATOR
+(cl-define-keysym #x00ab "guillemotleft") ;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+(cl-define-keysym #x00ac "notsign") ;U+00AC NOT SIGN
+(cl-define-keysym #x00ad "hyphen") ;U+00AD SOFT HYPHEN
+(cl-define-keysym #x00ae "registered") ;U+00AE REGISTERED SIGN
+(cl-define-keysym #x00af "macron") ;U+00AF MACRON
+(cl-define-keysym #x00b0 "degree") ;U+00B0 DEGREE SIGN
+(cl-define-keysym #x00b1 "plusminus") ;U+00B1 PLUS-MINUS SIGN
+(cl-define-keysym #x00b2 "twosuperior") ;U+00B2 SUPERSCRIPT TWO
+(cl-define-keysym #x00b3 "threesuperior") ;U+00B3 SUPERSCRIPT THREE
+(cl-define-keysym #x00b4 "acute") ;U+00B4 ACUTE ACCENT
+(cl-define-keysym #x00b5 "mu") ;U+00B5 MICRO SIGN
+(cl-define-keysym #x00b6 "paragraph") ;U+00B6 PILCROW SIGN
+(cl-define-keysym #x00b7 "periodcentered") ;U+00B7 MIDDLE DOT
+(cl-define-keysym #x00b8 "cedilla") ;U+00B8 CEDILLA
+(cl-define-keysym #x00b9 "onesuperior") ;U+00B9 SUPERSCRIPT ONE
+(cl-define-keysym #x00ba "masculine") ;U+00BA MASCULINE ORDINAL INDICATOR
+(cl-define-keysym #x00bb "guillemotright") ;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+(cl-define-keysym #x00bc "onequarter") ;U+00BC VULGAR FRACTION ONE QUARTER
+(cl-define-keysym #x00bd "onehalf") ;U+00BD VULGAR FRACTION ONE HALF
+(cl-define-keysym #x00be "threequarters") ;U+00BE VULGAR FRACTION THREE QUARTERS
+(cl-define-keysym #x00bf "questiondown") ;U+00BF INVERTED QUESTION MARK
+(cl-define-keysym #x00c0 "Agrave") ;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE
+(cl-define-keysym #x00c1 "Aacute") ;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE
+(cl-define-keysym #x00c2 "Acircumflex") ;U+00C2 LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+(cl-define-keysym #x00c3 "Atilde") ;U+00C3 LATIN CAPITAL LETTER A WITH TILDE
+(cl-define-keysym #x00c4 "Adiaeresis") ;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS
+(cl-define-keysym #x00c5 "Aring") ;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE
+(cl-define-keysym #x00c6 "AE") ;U+00C6 LATIN CAPITAL LETTER AE
+(cl-define-keysym #x00c7 "Ccedilla") ;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA
+(cl-define-keysym #x00c8 "Egrave") ;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE
+(cl-define-keysym #x00c9 "Eacute") ;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE
+(cl-define-keysym #x00ca "Ecircumflex") ;U+00CA LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+(cl-define-keysym #x00cb "Ediaeresis") ;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS
+(cl-define-keysym #x00cc "Igrave") ;U+00CC LATIN CAPITAL LETTER I WITH GRAVE
+(cl-define-keysym #x00cd "Iacute") ;U+00CD LATIN CAPITAL LETTER I WITH ACUTE
+(cl-define-keysym #x00ce "Icircumflex") ;U+00CE LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+(cl-define-keysym #x00cf "Idiaeresis") ;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS
+(cl-define-keysym #x00d0 "ETH") ;U+00D0 LATIN CAPITAL LETTER ETH
+(cl-define-keysym #x00d0 "Eth") ;deprecated
+(cl-define-keysym #x00d1 "Ntilde") ;U+00D1 LATIN CAPITAL LETTER N WITH TILDE
+(cl-define-keysym #x00d2 "Ograve") ;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE
+(cl-define-keysym #x00d3 "Oacute") ;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE
+(cl-define-keysym #x00d4 "Ocircumflex") ;U+00D4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+(cl-define-keysym #x00d5 "Otilde") ;U+00D5 LATIN CAPITAL LETTER O WITH TILDE
+(cl-define-keysym #x00d6 "Odiaeresis") ;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS
+(cl-define-keysym #x00d7 "multiply") ;U+00D7 MULTIPLICATION SIGN
+(cl-define-keysym #x00d8 "Oslash") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
+(cl-define-keysym #x00d8 "Ooblique") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
+(cl-define-keysym #x00d9 "Ugrave") ;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE
+(cl-define-keysym #x00da "Uacute") ;U+00DA LATIN CAPITAL LETTER U WITH ACUTE
+(cl-define-keysym #x00db "Ucircumflex") ;U+00DB LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+(cl-define-keysym #x00dc "Udiaeresis") ;U+00DC LATIN CAPITAL LETTER U WITH DIAERESIS
+(cl-define-keysym #x00dd "Yacute") ;U+00DD LATIN CAPITAL LETTER Y WITH ACUTE
+(cl-define-keysym #x00de "THORN") ;U+00DE LATIN CAPITAL LETTER THORN
+(cl-define-keysym #x00de "Thorn") ;deprecated
+(cl-define-keysym #x00df "ssharp") ;U+00DF LATIN SMALL LETTER SHARP S
+(cl-define-keysym #x00e0 "agrave") ;U+00E0 LATIN SMALL LETTER A WITH GRAVE
+(cl-define-keysym #x00e1 "aacute") ;U+00E1 LATIN SMALL LETTER A WITH ACUTE
+(cl-define-keysym #x00e2 "acircumflex") ;U+00E2 LATIN SMALL LETTER A WITH CIRCUMFLEX
+(cl-define-keysym #x00e3 "atilde") ;U+00E3 LATIN SMALL LETTER A WITH TILDE
+(cl-define-keysym #x00e4 "adiaeresis") ;U+00E4 LATIN SMALL LETTER A WITH DIAERESIS
+(cl-define-keysym #x00e5 "aring") ;U+00E5 LATIN SMALL LETTER A WITH RING ABOVE
+(cl-define-keysym #x00e6 "ae") ;U+00E6 LATIN SMALL LETTER AE
+(cl-define-keysym #x00e7 "ccedilla") ;U+00E7 LATIN SMALL LETTER C WITH CEDILLA
+(cl-define-keysym #x00e8 "egrave") ;U+00E8 LATIN SMALL LETTER E WITH GRAVE
+(cl-define-keysym #x00e9 "eacute") ;U+00E9 LATIN SMALL LETTER E WITH ACUTE
+(cl-define-keysym #x00ea "ecircumflex") ;U+00EA LATIN SMALL LETTER E WITH CIRCUMFLEX
+(cl-define-keysym #x00eb "ediaeresis") ;U+00EB LATIN SMALL LETTER E WITH DIAERESIS
+(cl-define-keysym #x00ec "igrave") ;U+00EC LATIN SMALL LETTER I WITH GRAVE
+(cl-define-keysym #x00ed "iacute") ;U+00ED LATIN SMALL LETTER I WITH ACUTE
+(cl-define-keysym #x00ee "icircumflex") ;U+00EE LATIN SMALL LETTER I WITH CIRCUMFLEX
+(cl-define-keysym #x00ef "idiaeresis") ;U+00EF LATIN SMALL LETTER I WITH DIAERESIS
+(cl-define-keysym #x00f0 "eth") ;U+00F0 LATIN SMALL LETTER ETH
+(cl-define-keysym #x00f1 "ntilde") ;U+00F1 LATIN SMALL LETTER N WITH TILDE
+(cl-define-keysym #x00f2 "ograve") ;U+00F2 LATIN SMALL LETTER O WITH GRAVE
+(cl-define-keysym #x00f3 "oacute") ;U+00F3 LATIN SMALL LETTER O WITH ACUTE
+(cl-define-keysym #x00f4 "ocircumflex") ;U+00F4 LATIN SMALL LETTER O WITH CIRCUMFLEX
+(cl-define-keysym #x00f5 "otilde") ;U+00F5 LATIN SMALL LETTER O WITH TILDE
+(cl-define-keysym #x00f6 "odiaeresis") ;U+00F6 LATIN SMALL LETTER O WITH DIAERESIS
+(cl-define-keysym #x00f7 "division") ;U+00F7 DIVISION SIGN
+(cl-define-keysym #x00f8 "oslash") ;U+00F8 LATIN SMALL LETTER O WITH STROKE
+(cl-define-keysym #x00f8 "ooblique") ;U+00F8 LATIN SMALL LETTER O WITH STROKE
+(cl-define-keysym #x00f9 "ugrave") ;U+00F9 LATIN SMALL LETTER U WITH GRAVE
+(cl-define-keysym #x00fa "uacute") ;U+00FA LATIN SMALL LETTER U WITH ACUTE
+(cl-define-keysym #x00fb "ucircumflex") ;U+00FB LATIN SMALL LETTER U WITH CIRCUMFLEX
+(cl-define-keysym #x00fc "udiaeresis") ;U+00FC LATIN SMALL LETTER U WITH DIAERESIS
+(cl-define-keysym #x00fd "yacute") ;U+00FD LATIN SMALL LETTER Y WITH ACUTE
+(cl-define-keysym #x00fe "thorn") ;U+00FE LATIN SMALL LETTER THORN
+(cl-define-keysym #x00ff "ydiaeresis") ;U+00FF LATIN SMALL LETTER Y WITH DIAERESIS
+(cl-define-keysym #x01a1 "Aogonek") ;U+0104 LATIN CAPITAL LETTER A WITH OGONEK
+(cl-define-keysym #x01a2 "breve") ;U+02D8 BREVE
+(cl-define-keysym #x01a3 "Lstroke") ;U+0141 LATIN CAPITAL LETTER L WITH STROKE
+(cl-define-keysym #x01a5 "Lcaron") ;U+013D LATIN CAPITAL LETTER L WITH CARON
+(cl-define-keysym #x01a6 "Sacute") ;U+015A LATIN CAPITAL LETTER S WITH ACUTE
+(cl-define-keysym #x01a9 "Scaron") ;U+0160 LATIN CAPITAL LETTER S WITH CARON
+(cl-define-keysym #x01aa "Scedilla") ;U+015E LATIN CAPITAL LETTER S WITH CEDILLA
+(cl-define-keysym #x01ab "Tcaron") ;U+0164 LATIN CAPITAL LETTER T WITH CARON
+(cl-define-keysym #x01ac "Zacute") ;U+0179 LATIN CAPITAL LETTER Z WITH ACUTE
+(cl-define-keysym #x01ae "Zcaron") ;U+017D LATIN CAPITAL LETTER Z WITH CARON
+(cl-define-keysym #x01af "Zabovedot") ;U+017B LATIN CAPITAL LETTER Z WITH DOT ABOVE
+(cl-define-keysym #x01b1 "aogonek") ;U+0105 LATIN SMALL LETTER A WITH OGONEK
+(cl-define-keysym #x01b2 "ogonek") ;U+02DB OGONEK
+(cl-define-keysym #x01b3 "lstroke") ;U+0142 LATIN SMALL LETTER L WITH STROKE
+(cl-define-keysym #x01b5 "lcaron") ;U+013E LATIN SMALL LETTER L WITH CARON
+(cl-define-keysym #x01b6 "sacute") ;U+015B LATIN SMALL LETTER S WITH ACUTE
+(cl-define-keysym #x01b7 "caron") ;U+02C7 CARON
+(cl-define-keysym #x01b9 "scaron") ;U+0161 LATIN SMALL LETTER S WITH CARON
+(cl-define-keysym #x01ba "scedilla") ;U+015F LATIN SMALL LETTER S WITH CEDILLA
+(cl-define-keysym #x01bb "tcaron") ;U+0165 LATIN SMALL LETTER T WITH CARON
+(cl-define-keysym #x01bc "zacute") ;U+017A LATIN SMALL LETTER Z WITH ACUTE
+(cl-define-keysym #x01bd "doubleacute") ;U+02DD DOUBLE ACUTE ACCENT
+(cl-define-keysym #x01be "zcaron") ;U+017E LATIN SMALL LETTER Z WITH CARON
+(cl-define-keysym #x01bf "zabovedot") ;U+017C LATIN SMALL LETTER Z WITH DOT ABOVE
+(cl-define-keysym #x01c0 "Racute") ;U+0154 LATIN CAPITAL LETTER R WITH ACUTE
+(cl-define-keysym #x01c3 "Abreve") ;U+0102 LATIN CAPITAL LETTER A WITH BREVE
+(cl-define-keysym #x01c5 "Lacute") ;U+0139 LATIN CAPITAL LETTER L WITH ACUTE
+(cl-define-keysym #x01c6 "Cacute") ;U+0106 LATIN CAPITAL LETTER C WITH ACUTE
+(cl-define-keysym #x01c8 "Ccaron") ;U+010C LATIN CAPITAL LETTER C WITH CARON
+(cl-define-keysym #x01ca "Eogonek") ;U+0118 LATIN CAPITAL LETTER E WITH OGONEK
+(cl-define-keysym #x01cc "Ecaron") ;U+011A LATIN CAPITAL LETTER E WITH CARON
+(cl-define-keysym #x01cf "Dcaron") ;U+010E LATIN CAPITAL LETTER D WITH CARON
+(cl-define-keysym #x01d0 "Dstroke") ;U+0110 LATIN CAPITAL LETTER D WITH STROKE
+(cl-define-keysym #x01d1 "Nacute") ;U+0143 LATIN CAPITAL LETTER N WITH ACUTE
+(cl-define-keysym #x01d2 "Ncaron") ;U+0147 LATIN CAPITAL LETTER N WITH CARON
+(cl-define-keysym #x01d5 "Odoubleacute") ;U+0150 LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+(cl-define-keysym #x01d8 "Rcaron") ;U+0158 LATIN CAPITAL LETTER R WITH CARON
+(cl-define-keysym #x01d9 "Uring") ;U+016E LATIN CAPITAL LETTER U WITH RING ABOVE
+(cl-define-keysym #x01db "Udoubleacute") ;U+0170 LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+(cl-define-keysym #x01de "Tcedilla") ;U+0162 LATIN CAPITAL LETTER T WITH CEDILLA
+(cl-define-keysym #x01e0 "racute") ;U+0155 LATIN SMALL LETTER R WITH ACUTE
+(cl-define-keysym #x01e3 "abreve") ;U+0103 LATIN SMALL LETTER A WITH BREVE
+(cl-define-keysym #x01e5 "lacute") ;U+013A LATIN SMALL LETTER L WITH ACUTE
+(cl-define-keysym #x01e6 "cacute") ;U+0107 LATIN SMALL LETTER C WITH ACUTE
+(cl-define-keysym #x01e8 "ccaron") ;U+010D LATIN SMALL LETTER C WITH CARON
+(cl-define-keysym #x01ea "eogonek") ;U+0119 LATIN SMALL LETTER E WITH OGONEK
+(cl-define-keysym #x01ec "ecaron") ;U+011B LATIN SMALL LETTER E WITH CARON
+(cl-define-keysym #x01ef "dcaron") ;U+010F LATIN SMALL LETTER D WITH CARON
+(cl-define-keysym #x01f0 "dstroke") ;U+0111 LATIN SMALL LETTER D WITH STROKE
+(cl-define-keysym #x01f1 "nacute") ;U+0144 LATIN SMALL LETTER N WITH ACUTE
+(cl-define-keysym #x01f2 "ncaron") ;U+0148 LATIN SMALL LETTER N WITH CARON
+(cl-define-keysym #x01f5 "odoubleacute") ;U+0151 LATIN SMALL LETTER O WITH DOUBLE ACUTE
+(cl-define-keysym #x01fb "udoubleacute") ;U+0171 LATIN SMALL LETTER U WITH DOUBLE ACUTE
+(cl-define-keysym #x01f8 "rcaron") ;U+0159 LATIN SMALL LETTER R WITH CARON
+(cl-define-keysym #x01f9 "uring") ;U+016F LATIN SMALL LETTER U WITH RING ABOVE
+(cl-define-keysym #x01fe "tcedilla") ;U+0163 LATIN SMALL LETTER T WITH CEDILLA
+(cl-define-keysym #x01ff "abovedot") ;U+02D9 DOT ABOVE
+(cl-define-keysym #x02a1 "Hstroke") ;U+0126 LATIN CAPITAL LETTER H WITH STROKE
+(cl-define-keysym #x02a6 "Hcircumflex") ;U+0124 LATIN CAPITAL LETTER H WITH CIRCUMFLEX
+(cl-define-keysym #x02a9 "Iabovedot") ;U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE
+(cl-define-keysym #x02ab "Gbreve") ;U+011E LATIN CAPITAL LETTER G WITH BREVE
+(cl-define-keysym #x02ac "Jcircumflex") ;U+0134 LATIN CAPITAL LETTER J WITH CIRCUMFLEX
+(cl-define-keysym #x02b1 "hstroke") ;U+0127 LATIN SMALL LETTER H WITH STROKE
+(cl-define-keysym #x02b6 "hcircumflex") ;U+0125 LATIN SMALL LETTER H WITH CIRCUMFLEX
+(cl-define-keysym #x02b9 "idotless") ;U+0131 LATIN SMALL LETTER DOTLESS I
+(cl-define-keysym #x02bb "gbreve") ;U+011F LATIN SMALL LETTER G WITH BREVE
+(cl-define-keysym #x02bc "jcircumflex") ;U+0135 LATIN SMALL LETTER J WITH CIRCUMFLEX
+(cl-define-keysym #x02c5 "Cabovedot") ;U+010A LATIN CAPITAL LETTER C WITH DOT ABOVE
+(cl-define-keysym #x02c6 "Ccircumflex") ;U+0108 LATIN CAPITAL LETTER C WITH CIRCUMFLEX
+(cl-define-keysym #x02d5 "Gabovedot") ;U+0120 LATIN CAPITAL LETTER G WITH DOT ABOVE
+(cl-define-keysym #x02d8 "Gcircumflex") ;U+011C LATIN CAPITAL LETTER G WITH CIRCUMFLEX
+(cl-define-keysym #x02dd "Ubreve") ;U+016C LATIN CAPITAL LETTER U WITH BREVE
+(cl-define-keysym #x02de "Scircumflex") ;U+015C LATIN CAPITAL LETTER S WITH CIRCUMFLEX
+(cl-define-keysym #x02e5 "cabovedot") ;U+010B LATIN SMALL LETTER C WITH DOT ABOVE
+(cl-define-keysym #x02e6 "ccircumflex") ;U+0109 LATIN SMALL LETTER C WITH CIRCUMFLEX
+(cl-define-keysym #x02f5 "gabovedot") ;U+0121 LATIN SMALL LETTER G WITH DOT ABOVE
+(cl-define-keysym #x02f8 "gcircumflex") ;U+011D LATIN SMALL LETTER G WITH CIRCUMFLEX
+(cl-define-keysym #x02fd "ubreve") ;U+016D LATIN SMALL LETTER U WITH BREVE
+(cl-define-keysym #x02fe "scircumflex") ;U+015D LATIN SMALL LETTER S WITH CIRCUMFLEX
+(cl-define-keysym #x03a2 "kra") ;U+0138 LATIN SMALL LETTER KRA
+(cl-define-keysym #x03a2 "kappa") ;deprecated
+(cl-define-keysym #x03a3 "Rcedilla") ;U+0156 LATIN CAPITAL LETTER R WITH CEDILLA
+(cl-define-keysym #x03a5 "Itilde") ;U+0128 LATIN CAPITAL LETTER I WITH TILDE
+(cl-define-keysym #x03a6 "Lcedilla") ;U+013B LATIN CAPITAL LETTER L WITH CEDILLA
+(cl-define-keysym #x03aa "Emacron") ;U+0112 LATIN CAPITAL LETTER E WITH MACRON
+(cl-define-keysym #x03ab "Gcedilla") ;U+0122 LATIN CAPITAL LETTER G WITH CEDILLA
+(cl-define-keysym #x03ac "Tslash") ;U+0166 LATIN CAPITAL LETTER T WITH STROKE
+(cl-define-keysym #x03b3 "rcedilla") ;U+0157 LATIN SMALL LETTER R WITH CEDILLA
+(cl-define-keysym #x03b5 "itilde") ;U+0129 LATIN SMALL LETTER I WITH TILDE
+(cl-define-keysym #x03b6 "lcedilla") ;U+013C LATIN SMALL LETTER L WITH CEDILLA
+(cl-define-keysym #x03ba "emacron") ;U+0113 LATIN SMALL LETTER E WITH MACRON
+(cl-define-keysym #x03bb "gcedilla") ;U+0123 LATIN SMALL LETTER G WITH CEDILLA
+(cl-define-keysym #x03bc "tslash") ;U+0167 LATIN SMALL LETTER T WITH STROKE
+(cl-define-keysym #x03bd "ENG") ;U+014A LATIN CAPITAL LETTER ENG
+(cl-define-keysym #x03bf "eng") ;U+014B LATIN SMALL LETTER ENG
+(cl-define-keysym #x03c0 "Amacron") ;U+0100 LATIN CAPITAL LETTER A WITH MACRON
+(cl-define-keysym #x03c7 "Iogonek") ;U+012E LATIN CAPITAL LETTER I WITH OGONEK
+(cl-define-keysym #x03cc "Eabovedot") ;U+0116 LATIN CAPITAL LETTER E WITH DOT ABOVE
+(cl-define-keysym #x03cf "Imacron") ;U+012A LATIN CAPITAL LETTER I WITH MACRON
+(cl-define-keysym #x03d1 "Ncedilla") ;U+0145 LATIN CAPITAL LETTER N WITH CEDILLA
+(cl-define-keysym #x03d2 "Omacron") ;U+014C LATIN CAPITAL LETTER O WITH MACRON
+(cl-define-keysym #x03d3 "Kcedilla") ;U+0136 LATIN CAPITAL LETTER K WITH CEDILLA
+(cl-define-keysym #x03d9 "Uogonek") ;U+0172 LATIN CAPITAL LETTER U WITH OGONEK
+(cl-define-keysym #x03dd "Utilde") ;U+0168 LATIN CAPITAL LETTER U WITH TILDE
+(cl-define-keysym #x03de "Umacron") ;U+016A LATIN CAPITAL LETTER U WITH MACRON
+(cl-define-keysym #x03e0 "amacron") ;U+0101 LATIN SMALL LETTER A WITH MACRON
+(cl-define-keysym #x03e7 "iogonek") ;U+012F LATIN SMALL LETTER I WITH OGONEK
+(cl-define-keysym #x03ec "eabovedot") ;U+0117 LATIN SMALL LETTER E WITH DOT ABOVE
+(cl-define-keysym #x03ef "imacron") ;U+012B LATIN SMALL LETTER I WITH MACRON
+(cl-define-keysym #x03f1 "ncedilla") ;U+0146 LATIN SMALL LETTER N WITH CEDILLA
+(cl-define-keysym #x03f2 "omacron") ;U+014D LATIN SMALL LETTER O WITH MACRON
+(cl-define-keysym #x03f3 "kcedilla") ;U+0137 LATIN SMALL LETTER K WITH CEDILLA
+(cl-define-keysym #x03f9 "uogonek") ;U+0173 LATIN SMALL LETTER U WITH OGONEK
+(cl-define-keysym #x03fd "utilde") ;U+0169 LATIN SMALL LETTER U WITH TILDE
+(cl-define-keysym #x03fe "umacron") ;U+016B LATIN SMALL LETTER U WITH MACRON
+(cl-define-keysym #x1001e02 "Babovedot") ;U+1E02 LATIN CAPITAL LETTER B WITH DOT ABOVE
+(cl-define-keysym #x1001e03 "babovedot") ;U+1E03 LATIN SMALL LETTER B WITH DOT ABOVE
+(cl-define-keysym #x1001e0a "Dabovedot") ;U+1E0A LATIN CAPITAL LETTER D WITH DOT ABOVE
+(cl-define-keysym #x1001e80 "Wgrave") ;U+1E80 LATIN CAPITAL LETTER W WITH GRAVE
+(cl-define-keysym #x1001e82 "Wacute") ;U+1E82 LATIN CAPITAL LETTER W WITH ACUTE
+(cl-define-keysym #x1001e0b "dabovedot") ;U+1E0B LATIN SMALL LETTER D WITH DOT ABOVE
+(cl-define-keysym #x1001ef2 "Ygrave") ;U+1EF2 LATIN CAPITAL LETTER Y WITH GRAVE
+(cl-define-keysym #x1001e1e "Fabovedot") ;U+1E1E LATIN CAPITAL LETTER F WITH DOT ABOVE
+(cl-define-keysym #x1001e1f "fabovedot") ;U+1E1F LATIN SMALL LETTER F WITH DOT ABOVE
+(cl-define-keysym #x1001e40 "Mabovedot") ;U+1E40 LATIN CAPITAL LETTER M WITH DOT ABOVE
+(cl-define-keysym #x1001e41 "mabovedot") ;U+1E41 LATIN SMALL LETTER M WITH DOT ABOVE
+(cl-define-keysym #x1001e56 "Pabovedot") ;U+1E56 LATIN CAPITAL LETTER P WITH DOT ABOVE
+(cl-define-keysym #x1001e81 "wgrave") ;U+1E81 LATIN SMALL LETTER W WITH GRAVE
+(cl-define-keysym #x1001e57 "pabovedot") ;U+1E57 LATIN SMALL LETTER P WITH DOT ABOVE
+(cl-define-keysym #x1001e83 "wacute") ;U+1E83 LATIN SMALL LETTER W WITH ACUTE
+(cl-define-keysym #x1001e60 "Sabovedot") ;U+1E60 LATIN CAPITAL LETTER S WITH DOT ABOVE
+(cl-define-keysym #x1001ef3 "ygrave") ;U+1EF3 LATIN SMALL LETTER Y WITH GRAVE
+(cl-define-keysym #x1001e84 "Wdiaeresis") ;U+1E84 LATIN CAPITAL LETTER W WITH DIAERESIS
+(cl-define-keysym #x1001e85 "wdiaeresis") ;U+1E85 LATIN SMALL LETTER W WITH DIAERESIS
+(cl-define-keysym #x1001e61 "sabovedot") ;U+1E61 LATIN SMALL LETTER S WITH DOT ABOVE
+(cl-define-keysym #x1000174 "Wcircumflex") ;U+0174 LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+(cl-define-keysym #x1001e6a "Tabovedot") ;U+1E6A LATIN CAPITAL LETTER T WITH DOT ABOVE
+(cl-define-keysym #x1000176 "Ycircumflex") ;U+0176 LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+(cl-define-keysym #x1000175 "wcircumflex") ;U+0175 LATIN SMALL LETTER W WITH CIRCUMFLEX
+(cl-define-keysym #x1001e6b "tabovedot") ;U+1E6B LATIN SMALL LETTER T WITH DOT ABOVE
+(cl-define-keysym #x1000177 "ycircumflex") ;U+0177 LATIN SMALL LETTER Y WITH CIRCUMFLEX
+(cl-define-keysym #x13bc "OE") ;U+0152 LATIN CAPITAL LIGATURE OE
+(cl-define-keysym #x13bd "oe") ;U+0153 LATIN SMALL LIGATURE OE
+(cl-define-keysym #x13be "Ydiaeresis") ;U+0178 LATIN CAPITAL LETTER Y WITH DIAERESIS
+(cl-define-keysym #x047e "overline") ;U+203E OVERLINE
+(cl-define-keysym #x04a1 "kana_fullstop") ;U+3002 IDEOGRAPHIC FULL STOP
+(cl-define-keysym #x04a2 "kana_openingbracket") ;U+300C LEFT CORNER BRACKET
+(cl-define-keysym #x04a3 "kana_closingbracket") ;U+300D RIGHT CORNER BRACKET
+(cl-define-keysym #x04a4 "kana_comma") ;U+3001 IDEOGRAPHIC COMMA
+(cl-define-keysym #x04a5 "kana_conjunctive") ;U+30FB KATAKANA MIDDLE DOT
+(cl-define-keysym #x04a5 "kana_middledot") ;deprecated
+(cl-define-keysym #x04a6 "kana_WO") ;U+30F2 KATAKANA LETTER WO
+(cl-define-keysym #x04a7 "kana_a") ;U+30A1 KATAKANA LETTER SMALL A
+(cl-define-keysym #x04a8 "kana_i") ;U+30A3 KATAKANA LETTER SMALL I
+(cl-define-keysym #x04a9 "kana_u") ;U+30A5 KATAKANA LETTER SMALL U
+(cl-define-keysym #x04aa "kana_e") ;U+30A7 KATAKANA LETTER SMALL E
+(cl-define-keysym #x04ab "kana_o") ;U+30A9 KATAKANA LETTER SMALL O
+(cl-define-keysym #x04ac "kana_ya") ;U+30E3 KATAKANA LETTER SMALL YA
+(cl-define-keysym #x04ad "kana_yu") ;U+30E5 KATAKANA LETTER SMALL YU
+(cl-define-keysym #x04ae "kana_yo") ;U+30E7 KATAKANA LETTER SMALL YO
+(cl-define-keysym #x04af "kana_tsu") ;U+30C3 KATAKANA LETTER SMALL TU
+(cl-define-keysym #x04af "kana_tu") ;deprecated
+(cl-define-keysym #x04b0 "prolongedsound") ;U+30FC KATAKANA-HIRAGANA PROLONGED SOUND MARK
+(cl-define-keysym #x04b1 "kana_A") ;U+30A2 KATAKANA LETTER A
+(cl-define-keysym #x04b2 "kana_I") ;U+30A4 KATAKANA LETTER I
+(cl-define-keysym #x04b3 "kana_U") ;U+30A6 KATAKANA LETTER U
+(cl-define-keysym #x04b4 "kana_E") ;U+30A8 KATAKANA LETTER E
+(cl-define-keysym #x04b5 "kana_O") ;U+30AA KATAKANA LETTER O
+(cl-define-keysym #x04b6 "kana_KA") ;U+30AB KATAKANA LETTER KA
+(cl-define-keysym #x04b7 "kana_KI") ;U+30AD KATAKANA LETTER KI
+(cl-define-keysym #x04b8 "kana_KU") ;U+30AF KATAKANA LETTER KU
+(cl-define-keysym #x04b9 "kana_KE") ;U+30B1 KATAKANA LETTER KE
+(cl-define-keysym #x04ba "kana_KO") ;U+30B3 KATAKANA LETTER KO
+(cl-define-keysym #x04bb "kana_SA") ;U+30B5 KATAKANA LETTER SA
+(cl-define-keysym #x04bc "kana_SHI") ;U+30B7 KATAKANA LETTER SI
+(cl-define-keysym #x04bd "kana_SU") ;U+30B9 KATAKANA LETTER SU
+(cl-define-keysym #x04be "kana_SE") ;U+30BB KATAKANA LETTER SE
+(cl-define-keysym #x04bf "kana_SO") ;U+30BD KATAKANA LETTER SO
+(cl-define-keysym #x04c0 "kana_TA") ;U+30BF KATAKANA LETTER TA
+(cl-define-keysym #x04c1 "kana_CHI") ;U+30C1 KATAKANA LETTER TI
+(cl-define-keysym #x04c1 "kana_TI") ;deprecated
+(cl-define-keysym #x04c2 "kana_TSU") ;U+30C4 KATAKANA LETTER TU
+(cl-define-keysym #x04c2 "kana_TU") ;deprecated
+(cl-define-keysym #x04c3 "kana_TE") ;U+30C6 KATAKANA LETTER TE
+(cl-define-keysym #x04c4 "kana_TO") ;U+30C8 KATAKANA LETTER TO
+(cl-define-keysym #x04c5 "kana_NA") ;U+30CA KATAKANA LETTER NA
+(cl-define-keysym #x04c6 "kana_NI") ;U+30CB KATAKANA LETTER NI
+(cl-define-keysym #x04c7 "kana_NU") ;U+30CC KATAKANA LETTER NU
+(cl-define-keysym #x04c8 "kana_NE") ;U+30CD KATAKANA LETTER NE
+(cl-define-keysym #x04c9 "kana_NO") ;U+30CE KATAKANA LETTER NO
+(cl-define-keysym #x04ca "kana_HA") ;U+30CF KATAKANA LETTER HA
+(cl-define-keysym #x04cb "kana_HI") ;U+30D2 KATAKANA LETTER HI
+(cl-define-keysym #x04cc "kana_FU") ;U+30D5 KATAKANA LETTER HU
+(cl-define-keysym #x04cc "kana_HU") ;deprecated
+(cl-define-keysym #x04cd "kana_HE") ;U+30D8 KATAKANA LETTER HE
+(cl-define-keysym #x04ce "kana_HO") ;U+30DB KATAKANA LETTER HO
+(cl-define-keysym #x04cf "kana_MA") ;U+30DE KATAKANA LETTER MA
+(cl-define-keysym #x04d0 "kana_MI") ;U+30DF KATAKANA LETTER MI
+(cl-define-keysym #x04d1 "kana_MU") ;U+30E0 KATAKANA LETTER MU
+(cl-define-keysym #x04d2 "kana_ME") ;U+30E1 KATAKANA LETTER ME
+(cl-define-keysym #x04d3 "kana_MO") ;U+30E2 KATAKANA LETTER MO
+(cl-define-keysym #x04d4 "kana_YA") ;U+30E4 KATAKANA LETTER YA
+(cl-define-keysym #x04d5 "kana_YU") ;U+30E6 KATAKANA LETTER YU
+(cl-define-keysym #x04d6 "kana_YO") ;U+30E8 KATAKANA LETTER YO
+(cl-define-keysym #x04d7 "kana_RA") ;U+30E9 KATAKANA LETTER RA
+(cl-define-keysym #x04d8 "kana_RI") ;U+30EA KATAKANA LETTER RI
+(cl-define-keysym #x04d9 "kana_RU") ;U+30EB KATAKANA LETTER RU
+(cl-define-keysym #x04da "kana_RE") ;U+30EC KATAKANA LETTER RE
+(cl-define-keysym #x04db "kana_RO") ;U+30ED KATAKANA LETTER RO
+(cl-define-keysym #x04dc "kana_WA") ;U+30EF KATAKANA LETTER WA
+(cl-define-keysym #x04dd "kana_N") ;U+30F3 KATAKANA LETTER N
+(cl-define-keysym #x04de "voicedsound") ;U+309B KATAKANA-HIRAGANA VOICED SOUND MARK
+(cl-define-keysym #x04df "semivoicedsound") ;U+309C KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+(cl-define-keysym #xff7e "kana_switch") ;Alias for mode_switch
+(cl-define-keysym #x10006f0 "Farsi_0") ;U+06F0 EXTENDED ARABIC-INDIC DIGIT ZERO
+(cl-define-keysym #x10006f1 "Farsi_1") ;U+06F1 EXTENDED ARABIC-INDIC DIGIT ONE
+(cl-define-keysym #x10006f2 "Farsi_2") ;U+06F2 EXTENDED ARABIC-INDIC DIGIT TWO
+(cl-define-keysym #x10006f3 "Farsi_3") ;U+06F3 EXTENDED ARABIC-INDIC DIGIT THREE
+(cl-define-keysym #x10006f4 "Farsi_4") ;U+06F4 EXTENDED ARABIC-INDIC DIGIT FOUR
+(cl-define-keysym #x10006f5 "Farsi_5") ;U+06F5 EXTENDED ARABIC-INDIC DIGIT FIVE
+(cl-define-keysym #x10006f6 "Farsi_6") ;U+06F6 EXTENDED ARABIC-INDIC DIGIT SIX
+(cl-define-keysym #x10006f7 "Farsi_7") ;U+06F7 EXTENDED ARABIC-INDIC DIGIT SEVEN
+(cl-define-keysym #x10006f8 "Farsi_8") ;U+06F8 EXTENDED ARABIC-INDIC DIGIT EIGHT
+(cl-define-keysym #x10006f9 "Farsi_9") ;U+06F9 EXTENDED ARABIC-INDIC DIGIT NINE
+(cl-define-keysym #x100066a "Arabic_percent") ;U+066A ARABIC PERCENT SIGN
+(cl-define-keysym #x1000670 "Arabic_superscript_alef") ;U+0670 ARABIC LETTER SUPERSCRIPT ALEF
+(cl-define-keysym #x1000679 "Arabic_tteh") ;U+0679 ARABIC LETTER TTEH
+(cl-define-keysym #x100067e "Arabic_peh") ;U+067E ARABIC LETTER PEH
+(cl-define-keysym #x1000686 "Arabic_tcheh") ;U+0686 ARABIC LETTER TCHEH
+(cl-define-keysym #x1000688 "Arabic_ddal") ;U+0688 ARABIC LETTER DDAL
+(cl-define-keysym #x1000691 "Arabic_rreh") ;U+0691 ARABIC LETTER RREH
+(cl-define-keysym #x05ac "Arabic_comma") ;U+060C ARABIC COMMA
+(cl-define-keysym #x10006d4 "Arabic_fullstop") ;U+06D4 ARABIC FULL STOP
+(cl-define-keysym #x1000660 "Arabic_0") ;U+0660 ARABIC-INDIC DIGIT ZERO
+(cl-define-keysym #x1000661 "Arabic_1") ;U+0661 ARABIC-INDIC DIGIT ONE
+(cl-define-keysym #x1000662 "Arabic_2") ;U+0662 ARABIC-INDIC DIGIT TWO
+(cl-define-keysym #x1000663 "Arabic_3") ;U+0663 ARABIC-INDIC DIGIT THREE
+(cl-define-keysym #x1000664 "Arabic_4") ;U+0664 ARABIC-INDIC DIGIT FOUR
+(cl-define-keysym #x1000665 "Arabic_5") ;U+0665 ARABIC-INDIC DIGIT FIVE
+(cl-define-keysym #x1000666 "Arabic_6") ;U+0666 ARABIC-INDIC DIGIT SIX
+(cl-define-keysym #x1000667 "Arabic_7") ;U+0667 ARABIC-INDIC DIGIT SEVEN
+(cl-define-keysym #x1000668 "Arabic_8") ;U+0668 ARABIC-INDIC DIGIT EIGHT
+(cl-define-keysym #x1000669 "Arabic_9") ;U+0669 ARABIC-INDIC DIGIT NINE
+(cl-define-keysym #x05bb "Arabic_semicolon") ;U+061B ARABIC SEMICOLON
+(cl-define-keysym #x05bf "Arabic_question_mark") ;U+061F ARABIC QUESTION MARK
+(cl-define-keysym #x05c1 "Arabic_hamza") ;U+0621 ARABIC LETTER HAMZA
+(cl-define-keysym #x05c2 "Arabic_maddaonalef") ;U+0622 ARABIC LETTER ALEF WITH MADDA ABOVE
+(cl-define-keysym #x05c3 "Arabic_hamzaonalef") ;U+0623 ARABIC LETTER ALEF WITH HAMZA ABOVE
+(cl-define-keysym #x05c4 "Arabic_hamzaonwaw") ;U+0624 ARABIC LETTER WAW WITH HAMZA ABOVE
+(cl-define-keysym #x05c5 "Arabic_hamzaunderalef") ;U+0625 ARABIC LETTER ALEF WITH HAMZA BELOW
+(cl-define-keysym #x05c6 "Arabic_hamzaonyeh") ;U+0626 ARABIC LETTER YEH WITH HAMZA ABOVE
+(cl-define-keysym #x05c7 "Arabic_alef") ;U+0627 ARABIC LETTER ALEF
+(cl-define-keysym #x05c8 "Arabic_beh") ;U+0628 ARABIC LETTER BEH
+(cl-define-keysym #x05c9 "Arabic_tehmarbuta") ;U+0629 ARABIC LETTER TEH MARBUTA
+(cl-define-keysym #x05ca "Arabic_teh") ;U+062A ARABIC LETTER TEH
+(cl-define-keysym #x05cb "Arabic_theh") ;U+062B ARABIC LETTER THEH
+(cl-define-keysym #x05cc "Arabic_jeem") ;U+062C ARABIC LETTER JEEM
+(cl-define-keysym #x05cd "Arabic_hah") ;U+062D ARABIC LETTER HAH
+(cl-define-keysym #x05ce "Arabic_khah") ;U+062E ARABIC LETTER KHAH
+(cl-define-keysym #x05cf "Arabic_dal") ;U+062F ARABIC LETTER DAL
+(cl-define-keysym #x05d0 "Arabic_thal") ;U+0630 ARABIC LETTER THAL
+(cl-define-keysym #x05d1 "Arabic_ra") ;U+0631 ARABIC LETTER REH
+(cl-define-keysym #x05d2 "Arabic_zain") ;U+0632 ARABIC LETTER ZAIN
+(cl-define-keysym #x05d3 "Arabic_seen") ;U+0633 ARABIC LETTER SEEN
+(cl-define-keysym #x05d4 "Arabic_sheen") ;U+0634 ARABIC LETTER SHEEN
+(cl-define-keysym #x05d5 "Arabic_sad") ;U+0635 ARABIC LETTER SAD
+(cl-define-keysym #x05d6 "Arabic_dad") ;U+0636 ARABIC LETTER DAD
+(cl-define-keysym #x05d7 "Arabic_tah") ;U+0637 ARABIC LETTER TAH
+(cl-define-keysym #x05d8 "Arabic_zah") ;U+0638 ARABIC LETTER ZAH
+(cl-define-keysym #x05d9 "Arabic_ain") ;U+0639 ARABIC LETTER AIN
+(cl-define-keysym #x05da "Arabic_ghain") ;U+063A ARABIC LETTER GHAIN
+(cl-define-keysym #x05e0 "Arabic_tatweel") ;U+0640 ARABIC TATWEEL
+(cl-define-keysym #x05e1 "Arabic_feh") ;U+0641 ARABIC LETTER FEH
+(cl-define-keysym #x05e2 "Arabic_qaf") ;U+0642 ARABIC LETTER QAF
+(cl-define-keysym #x05e3 "Arabic_kaf") ;U+0643 ARABIC LETTER KAF
+(cl-define-keysym #x05e4 "Arabic_lam") ;U+0644 ARABIC LETTER LAM
+(cl-define-keysym #x05e5 "Arabic_meem") ;U+0645 ARABIC LETTER MEEM
+(cl-define-keysym #x05e6 "Arabic_noon") ;U+0646 ARABIC LETTER NOON
+(cl-define-keysym #x05e7 "Arabic_ha") ;U+0647 ARABIC LETTER HEH
+(cl-define-keysym #x05e7 "Arabic_heh") ;deprecated
+(cl-define-keysym #x05e8 "Arabic_waw") ;U+0648 ARABIC LETTER WAW
+(cl-define-keysym #x05e9 "Arabic_alefmaksura") ;U+0649 ARABIC LETTER ALEF MAKSURA
+(cl-define-keysym #x05ea "Arabic_yeh") ;U+064A ARABIC LETTER YEH
+(cl-define-keysym #x05eb "Arabic_fathatan") ;U+064B ARABIC FATHATAN
+(cl-define-keysym #x05ec "Arabic_dammatan") ;U+064C ARABIC DAMMATAN
+(cl-define-keysym #x05ed "Arabic_kasratan") ;U+064D ARABIC KASRATAN
+(cl-define-keysym #x05ee "Arabic_fatha") ;U+064E ARABIC FATHA
+(cl-define-keysym #x05ef "Arabic_damma") ;U+064F ARABIC DAMMA
+(cl-define-keysym #x05f0 "Arabic_kasra") ;U+0650 ARABIC KASRA
+(cl-define-keysym #x05f1 "Arabic_shadda") ;U+0651 ARABIC SHADDA
+(cl-define-keysym #x05f2 "Arabic_sukun") ;U+0652 ARABIC SUKUN
+(cl-define-keysym #x1000653 "Arabic_madda_above") ;U+0653 ARABIC MADDAH ABOVE
+(cl-define-keysym #x1000654 "Arabic_hamza_above") ;U+0654 ARABIC HAMZA ABOVE
+(cl-define-keysym #x1000655 "Arabic_hamza_below") ;U+0655 ARABIC HAMZA BELOW
+(cl-define-keysym #x1000698 "Arabic_jeh") ;U+0698 ARABIC LETTER JEH
+(cl-define-keysym #x10006a4 "Arabic_veh") ;U+06A4 ARABIC LETTER VEH
+(cl-define-keysym #x10006a9 "Arabic_keheh") ;U+06A9 ARABIC LETTER KEHEH
+(cl-define-keysym #x10006af "Arabic_gaf") ;U+06AF ARABIC LETTER GAF
+(cl-define-keysym #x10006ba "Arabic_noon_ghunna") ;U+06BA ARABIC LETTER NOON GHUNNA
+(cl-define-keysym #x10006be "Arabic_heh_doachashmee") ;U+06BE ARABIC LETTER HEH DOACHASHMEE
+(cl-define-keysym #x10006cc "Farsi_yeh") ;U+06CC ARABIC LETTER FARSI YEH
+(cl-define-keysym #x10006cc "Arabic_farsi_yeh") ;U+06CC ARABIC LETTER FARSI YEH
+(cl-define-keysym #x10006d2 "Arabic_yeh_baree") ;U+06D2 ARABIC LETTER YEH BARREE
+(cl-define-keysym #x10006c1 "Arabic_heh_goal") ;U+06C1 ARABIC LETTER HEH GOAL
+(cl-define-keysym #xff7e "Arabic_switch") ;Alias for mode_switch
+(cl-define-keysym #x1000492 "Cyrillic_GHE_bar") ;U+0492 CYRILLIC CAPITAL LETTER GHE WITH STROKE
+(cl-define-keysym #x1000493 "Cyrillic_ghe_bar") ;U+0493 CYRILLIC SMALL LETTER GHE WITH STROKE
+(cl-define-keysym #x1000496 "Cyrillic_ZHE_descender") ;U+0496 CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER
+(cl-define-keysym #x1000497 "Cyrillic_zhe_descender") ;U+0497 CYRILLIC SMALL LETTER ZHE WITH DESCENDER
+(cl-define-keysym #x100049a "Cyrillic_KA_descender") ;U+049A CYRILLIC CAPITAL LETTER KA WITH DESCENDER
+(cl-define-keysym #x100049b "Cyrillic_ka_descender") ;U+049B CYRILLIC SMALL LETTER KA WITH DESCENDER
+(cl-define-keysym #x100049c "Cyrillic_KA_vertstroke") ;U+049C CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE
+(cl-define-keysym #x100049d "Cyrillic_ka_vertstroke") ;U+049D CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE
+(cl-define-keysym #x10004a2 "Cyrillic_EN_descender") ;U+04A2 CYRILLIC CAPITAL LETTER EN WITH DESCENDER
+(cl-define-keysym #x10004a3 "Cyrillic_en_descender") ;U+04A3 CYRILLIC SMALL LETTER EN WITH DESCENDER
+(cl-define-keysym #x10004ae "Cyrillic_U_straight") ;U+04AE CYRILLIC CAPITAL LETTER STRAIGHT U
+(cl-define-keysym #x10004af "Cyrillic_u_straight") ;U+04AF CYRILLIC SMALL LETTER STRAIGHT U
+(cl-define-keysym #x10004b0 "Cyrillic_U_straight_bar") ;U+04B0 CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE
+(cl-define-keysym #x10004b1 "Cyrillic_u_straight_bar") ;U+04B1 CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE
+(cl-define-keysym #x10004b2 "Cyrillic_HA_descender") ;U+04B2 CYRILLIC CAPITAL LETTER HA WITH DESCENDER
+(cl-define-keysym #x10004b3 "Cyrillic_ha_descender") ;U+04B3 CYRILLIC SMALL LETTER HA WITH DESCENDER
+(cl-define-keysym #x10004b6 "Cyrillic_CHE_descender") ;U+04B6 CYRILLIC CAPITAL LETTER CHE WITH DESCENDER
+(cl-define-keysym #x10004b7 "Cyrillic_che_descender") ;U+04B7 CYRILLIC SMALL LETTER CHE WITH DESCENDER
+(cl-define-keysym #x10004b8 "Cyrillic_CHE_vertstroke") ;U+04B8 CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE
+(cl-define-keysym #x10004b9 "Cyrillic_che_vertstroke") ;U+04B9 CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE
+(cl-define-keysym #x10004ba "Cyrillic_SHHA") ;U+04BA CYRILLIC CAPITAL LETTER SHHA
+(cl-define-keysym #x10004bb "Cyrillic_shha") ;U+04BB CYRILLIC SMALL LETTER SHHA
+(cl-define-keysym #x10004d8 "Cyrillic_SCHWA") ;U+04D8 CYRILLIC CAPITAL LETTER SCHWA
+(cl-define-keysym #x10004d9 "Cyrillic_schwa") ;U+04D9 CYRILLIC SMALL LETTER SCHWA
+(cl-define-keysym #x10004e2 "Cyrillic_I_macron") ;U+04E2 CYRILLIC CAPITAL LETTER I WITH MACRON
+(cl-define-keysym #x10004e3 "Cyrillic_i_macron") ;U+04E3 CYRILLIC SMALL LETTER I WITH MACRON
+(cl-define-keysym #x10004e8 "Cyrillic_O_bar") ;U+04E8 CYRILLIC CAPITAL LETTER BARRED O
+(cl-define-keysym #x10004e9 "Cyrillic_o_bar") ;U+04E9 CYRILLIC SMALL LETTER BARRED O
+(cl-define-keysym #x10004ee "Cyrillic_U_macron") ;U+04EE CYRILLIC CAPITAL LETTER U WITH MACRON
+(cl-define-keysym #x10004ef "Cyrillic_u_macron") ;U+04EF CYRILLIC SMALL LETTER U WITH MACRON
+(cl-define-keysym #x06a1 "Serbian_dje") ;U+0452 CYRILLIC SMALL LETTER DJE
+(cl-define-keysym #x06a2 "Macedonia_gje") ;U+0453 CYRILLIC SMALL LETTER GJE
+(cl-define-keysym #x06a3 "Cyrillic_io") ;U+0451 CYRILLIC SMALL LETTER IO
+(cl-define-keysym #x06a4 "Ukrainian_ie") ;U+0454 CYRILLIC SMALL LETTER UKRAINIAN IE
+(cl-define-keysym #x06a4 "Ukranian_je") ;deprecated
+(cl-define-keysym #x06a5 "Macedonia_dse") ;U+0455 CYRILLIC SMALL LETTER DZE
+(cl-define-keysym #x06a6 "Ukrainian_i") ;U+0456 CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+(cl-define-keysym #x06a6 "Ukranian_i") ;deprecated
+(cl-define-keysym #x06a7 "Ukrainian_yi") ;U+0457 CYRILLIC SMALL LETTER YI
+(cl-define-keysym #x06a7 "Ukranian_yi") ;deprecated
+(cl-define-keysym #x06a8 "Cyrillic_je") ;U+0458 CYRILLIC SMALL LETTER JE
+(cl-define-keysym #x06a8 "Serbian_je") ;deprecated
+(cl-define-keysym #x06a9 "Cyrillic_lje") ;U+0459 CYRILLIC SMALL LETTER LJE
+(cl-define-keysym #x06a9 "Serbian_lje") ;deprecated
+(cl-define-keysym #x06aa "Cyrillic_nje") ;U+045A CYRILLIC SMALL LETTER NJE
+(cl-define-keysym #x06aa "Serbian_nje") ;deprecated
+(cl-define-keysym #x06ab "Serbian_tshe") ;U+045B CYRILLIC SMALL LETTER TSHE
+(cl-define-keysym #x06ac "Macedonia_kje") ;U+045C CYRILLIC SMALL LETTER KJE
+(cl-define-keysym #x06ad "Ukrainian_ghe_with_upturn") ;U+0491 CYRILLIC SMALL LETTER GHE WITH UPTURN
+(cl-define-keysym #x06ae "Byelorussian_shortu") ;U+045E CYRILLIC SMALL LETTER SHORT U
+(cl-define-keysym #x06af "Cyrillic_dzhe") ;U+045F CYRILLIC SMALL LETTER DZHE
+(cl-define-keysym #x06af "Serbian_dze") ;deprecated
+(cl-define-keysym #x06b0 "numerosign") ;U+2116 NUMERO SIGN
+(cl-define-keysym #x06b1 "Serbian_DJE") ;U+0402 CYRILLIC CAPITAL LETTER DJE
+(cl-define-keysym #x06b2 "Macedonia_GJE") ;U+0403 CYRILLIC CAPITAL LETTER GJE
+(cl-define-keysym #x06b3 "Cyrillic_IO") ;U+0401 CYRILLIC CAPITAL LETTER IO
+(cl-define-keysym #x06b4 "Ukrainian_IE") ;U+0404 CYRILLIC CAPITAL LETTER UKRAINIAN IE
+(cl-define-keysym #x06b4 "Ukranian_JE") ;deprecated
+(cl-define-keysym #x06b5 "Macedonia_DSE") ;U+0405 CYRILLIC CAPITAL LETTER DZE
+(cl-define-keysym #x06b6 "Ukrainian_I") ;U+0406 CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+(cl-define-keysym #x06b6 "Ukranian_I") ;deprecated
+(cl-define-keysym #x06b7 "Ukrainian_YI") ;U+0407 CYRILLIC CAPITAL LETTER YI
+(cl-define-keysym #x06b7 "Ukranian_YI") ;deprecated
+(cl-define-keysym #x06b8 "Cyrillic_JE") ;U+0408 CYRILLIC CAPITAL LETTER JE
+(cl-define-keysym #x06b8 "Serbian_JE") ;deprecated
+(cl-define-keysym #x06b9 "Cyrillic_LJE") ;U+0409 CYRILLIC CAPITAL LETTER LJE
+(cl-define-keysym #x06b9 "Serbian_LJE") ;deprecated
+(cl-define-keysym #x06ba "Cyrillic_NJE") ;U+040A CYRILLIC CAPITAL LETTER NJE
+(cl-define-keysym #x06ba "Serbian_NJE") ;deprecated
+(cl-define-keysym #x06bb "Serbian_TSHE") ;U+040B CYRILLIC CAPITAL LETTER TSHE
+(cl-define-keysym #x06bc "Macedonia_KJE") ;U+040C CYRILLIC CAPITAL LETTER KJE
+(cl-define-keysym #x06bd "Ukrainian_GHE_WITH_UPTURN") ;U+0490 CYRILLIC CAPITAL LETTER GHE WITH UPTURN
+(cl-define-keysym #x06be "Byelorussian_SHORTU") ;U+040E CYRILLIC CAPITAL LETTER SHORT U
+(cl-define-keysym #x06bf "Cyrillic_DZHE") ;U+040F CYRILLIC CAPITAL LETTER DZHE
+(cl-define-keysym #x06bf "Serbian_DZE") ;deprecated
+(cl-define-keysym #x06c0 "Cyrillic_yu") ;U+044E CYRILLIC SMALL LETTER YU
+(cl-define-keysym #x06c1 "Cyrillic_a") ;U+0430 CYRILLIC SMALL LETTER A
+(cl-define-keysym #x06c2 "Cyrillic_be") ;U+0431 CYRILLIC SMALL LETTER BE
+(cl-define-keysym #x06c3 "Cyrillic_tse") ;U+0446 CYRILLIC SMALL LETTER TSE
+(cl-define-keysym #x06c4 "Cyrillic_de") ;U+0434 CYRILLIC SMALL LETTER DE
+(cl-define-keysym #x06c5 "Cyrillic_ie") ;U+0435 CYRILLIC SMALL LETTER IE
+(cl-define-keysym #x06c6 "Cyrillic_ef") ;U+0444 CYRILLIC SMALL LETTER EF
+(cl-define-keysym #x06c7 "Cyrillic_ghe") ;U+0433 CYRILLIC SMALL LETTER GHE
+(cl-define-keysym #x06c8 "Cyrillic_ha") ;U+0445 CYRILLIC SMALL LETTER HA
+(cl-define-keysym #x06c9 "Cyrillic_i") ;U+0438 CYRILLIC SMALL LETTER I
+(cl-define-keysym #x06ca "Cyrillic_shorti") ;U+0439 CYRILLIC SMALL LETTER SHORT I
+(cl-define-keysym #x06cb "Cyrillic_ka") ;U+043A CYRILLIC SMALL LETTER KA
+(cl-define-keysym #x06cc "Cyrillic_el") ;U+043B CYRILLIC SMALL LETTER EL
+(cl-define-keysym #x06cd "Cyrillic_em") ;U+043C CYRILLIC SMALL LETTER EM
+(cl-define-keysym #x06ce "Cyrillic_en") ;U+043D CYRILLIC SMALL LETTER EN
+(cl-define-keysym #x06cf "Cyrillic_o") ;U+043E CYRILLIC SMALL LETTER O
+(cl-define-keysym #x06d0 "Cyrillic_pe") ;U+043F CYRILLIC SMALL LETTER PE
+(cl-define-keysym #x06d1 "Cyrillic_ya") ;U+044F CYRILLIC SMALL LETTER YA
+(cl-define-keysym #x06d2 "Cyrillic_er") ;U+0440 CYRILLIC SMALL LETTER ER
+(cl-define-keysym #x06d3 "Cyrillic_es") ;U+0441 CYRILLIC SMALL LETTER ES
+(cl-define-keysym #x06d4 "Cyrillic_te") ;U+0442 CYRILLIC SMALL LETTER TE
+(cl-define-keysym #x06d5 "Cyrillic_u") ;U+0443 CYRILLIC SMALL LETTER U
+(cl-define-keysym #x06d6 "Cyrillic_zhe") ;U+0436 CYRILLIC SMALL LETTER ZHE
+(cl-define-keysym #x06d7 "Cyrillic_ve") ;U+0432 CYRILLIC SMALL LETTER VE
+(cl-define-keysym #x06d8 "Cyrillic_softsign") ;U+044C CYRILLIC SMALL LETTER SOFT SIGN
+(cl-define-keysym #x06d9 "Cyrillic_yeru") ;U+044B CYRILLIC SMALL LETTER YERU
+(cl-define-keysym #x06da "Cyrillic_ze") ;U+0437 CYRILLIC SMALL LETTER ZE
+(cl-define-keysym #x06db "Cyrillic_sha") ;U+0448 CYRILLIC SMALL LETTER SHA
+(cl-define-keysym #x06dc "Cyrillic_e") ;U+044D CYRILLIC SMALL LETTER E
+(cl-define-keysym #x06dd "Cyrillic_shcha") ;U+0449 CYRILLIC SMALL LETTER SHCHA
+(cl-define-keysym #x06de "Cyrillic_che") ;U+0447 CYRILLIC SMALL LETTER CHE
+(cl-define-keysym #x06df "Cyrillic_hardsign") ;U+044A CYRILLIC SMALL LETTER HARD SIGN
+(cl-define-keysym #x06e0 "Cyrillic_YU") ;U+042E CYRILLIC CAPITAL LETTER YU
+(cl-define-keysym #x06e1 "Cyrillic_A") ;U+0410 CYRILLIC CAPITAL LETTER A
+(cl-define-keysym #x06e2 "Cyrillic_BE") ;U+0411 CYRILLIC CAPITAL LETTER BE
+(cl-define-keysym #x06e3 "Cyrillic_TSE") ;U+0426 CYRILLIC CAPITAL LETTER TSE
+(cl-define-keysym #x06e4 "Cyrillic_DE") ;U+0414 CYRILLIC CAPITAL LETTER DE
+(cl-define-keysym #x06e5 "Cyrillic_IE") ;U+0415 CYRILLIC CAPITAL LETTER IE
+(cl-define-keysym #x06e6 "Cyrillic_EF") ;U+0424 CYRILLIC CAPITAL LETTER EF
+(cl-define-keysym #x06e7 "Cyrillic_GHE") ;U+0413 CYRILLIC CAPITAL LETTER GHE
+(cl-define-keysym #x06e8 "Cyrillic_HA") ;U+0425 CYRILLIC CAPITAL LETTER HA
+(cl-define-keysym #x06e9 "Cyrillic_I") ;U+0418 CYRILLIC CAPITAL LETTER I
+(cl-define-keysym #x06ea "Cyrillic_SHORTI") ;U+0419 CYRILLIC CAPITAL LETTER SHORT I
+(cl-define-keysym #x06eb "Cyrillic_KA") ;U+041A CYRILLIC CAPITAL LETTER KA
+(cl-define-keysym #x06ec "Cyrillic_EL") ;U+041B CYRILLIC CAPITAL LETTER EL
+(cl-define-keysym #x06ed "Cyrillic_EM") ;U+041C CYRILLIC CAPITAL LETTER EM
+(cl-define-keysym #x06ee "Cyrillic_EN") ;U+041D CYRILLIC CAPITAL LETTER EN
+(cl-define-keysym #x06ef "Cyrillic_O") ;U+041E CYRILLIC CAPITAL LETTER O
+(cl-define-keysym #x06f0 "Cyrillic_PE") ;U+041F CYRILLIC CAPITAL LETTER PE
+(cl-define-keysym #x06f1 "Cyrillic_YA") ;U+042F CYRILLIC CAPITAL LETTER YA
+(cl-define-keysym #x06f2 "Cyrillic_ER") ;U+0420 CYRILLIC CAPITAL LETTER ER
+(cl-define-keysym #x06f3 "Cyrillic_ES") ;U+0421 CYRILLIC CAPITAL LETTER ES
+(cl-define-keysym #x06f4 "Cyrillic_TE") ;U+0422 CYRILLIC CAPITAL LETTER TE
+(cl-define-keysym #x06f5 "Cyrillic_U") ;U+0423 CYRILLIC CAPITAL LETTER U
+(cl-define-keysym #x06f6 "Cyrillic_ZHE") ;U+0416 CYRILLIC CAPITAL LETTER ZHE
+(cl-define-keysym #x06f7 "Cyrillic_VE") ;U+0412 CYRILLIC CAPITAL LETTER VE
+(cl-define-keysym #x06f8 "Cyrillic_SOFTSIGN") ;U+042C CYRILLIC CAPITAL LETTER SOFT SIGN
+(cl-define-keysym #x06f9 "Cyrillic_YERU") ;U+042B CYRILLIC CAPITAL LETTER YERU
+(cl-define-keysym #x06fa "Cyrillic_ZE") ;U+0417 CYRILLIC CAPITAL LETTER ZE
+(cl-define-keysym #x06fb "Cyrillic_SHA") ;U+0428 CYRILLIC CAPITAL LETTER SHA
+(cl-define-keysym #x06fc "Cyrillic_E") ;U+042D CYRILLIC CAPITAL LETTER E
+(cl-define-keysym #x06fd "Cyrillic_SHCHA") ;U+0429 CYRILLIC CAPITAL LETTER SHCHA
+(cl-define-keysym #x06fe "Cyrillic_CHE") ;U+0427 CYRILLIC CAPITAL LETTER CHE
+(cl-define-keysym #x06ff "Cyrillic_HARDSIGN") ;U+042A CYRILLIC CAPITAL LETTER HARD SIGN
+(cl-define-keysym #x07a1 "Greek_ALPHAaccent") ;U+0386 GREEK CAPITAL LETTER ALPHA WITH TONOS
+(cl-define-keysym #x07a2 "Greek_EPSILONaccent") ;U+0388 GREEK CAPITAL LETTER EPSILON WITH TONOS
+(cl-define-keysym #x07a3 "Greek_ETAaccent") ;U+0389 GREEK CAPITAL LETTER ETA WITH TONOS
+(cl-define-keysym #x07a4 "Greek_IOTAaccent") ;U+038A GREEK CAPITAL LETTER IOTA WITH TONOS
+(cl-define-keysym #x07a5 "Greek_IOTAdieresis") ;U+03AA GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+(cl-define-keysym #x07a5 "Greek_IOTAdiaeresis") ;old typo
+(cl-define-keysym #x07a7 "Greek_OMICRONaccent") ;U+038C GREEK CAPITAL LETTER OMICRON WITH TONOS
+(cl-define-keysym #x07a8 "Greek_UPSILONaccent") ;U+038E GREEK CAPITAL LETTER UPSILON WITH TONOS
+(cl-define-keysym #x07a9 "Greek_UPSILONdieresis") ;U+03AB GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+(cl-define-keysym #x07ab "Greek_OMEGAaccent") ;U+038F GREEK CAPITAL LETTER OMEGA WITH TONOS
+(cl-define-keysym #x07ae "Greek_accentdieresis") ;U+0385 GREEK DIALYTIKA TONOS
+(cl-define-keysym #x07af "Greek_horizbar") ;U+2015 HORIZONTAL BAR
+(cl-define-keysym #x07b1 "Greek_alphaaccent") ;U+03AC GREEK SMALL LETTER ALPHA WITH TONOS
+(cl-define-keysym #x07b2 "Greek_epsilonaccent") ;U+03AD GREEK SMALL LETTER EPSILON WITH TONOS
+(cl-define-keysym #x07b3 "Greek_etaaccent") ;U+03AE GREEK SMALL LETTER ETA WITH TONOS
+(cl-define-keysym #x07b4 "Greek_iotaaccent") ;U+03AF GREEK SMALL LETTER IOTA WITH TONOS
+(cl-define-keysym #x07b5 "Greek_iotadieresis") ;U+03CA GREEK SMALL LETTER IOTA WITH DIALYTIKA
+(cl-define-keysym #x07b6 "Greek_iotaaccentdieresis") ;U+0390 GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+(cl-define-keysym #x07b7 "Greek_omicronaccent") ;U+03CC GREEK SMALL LETTER OMICRON WITH TONOS
+(cl-define-keysym #x07b8 "Greek_upsilonaccent") ;U+03CD GREEK SMALL LETTER UPSILON WITH TONOS
+(cl-define-keysym #x07b9 "Greek_upsilondieresis") ;U+03CB GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+(cl-define-keysym #x07ba "Greek_upsilonaccentdieresis") ;U+03B0 GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+(cl-define-keysym #x07bb "Greek_omegaaccent") ;U+03CE GREEK SMALL LETTER OMEGA WITH TONOS
+(cl-define-keysym #x07c1 "Greek_ALPHA") ;U+0391 GREEK CAPITAL LETTER ALPHA
+(cl-define-keysym #x07c2 "Greek_BETA") ;U+0392 GREEK CAPITAL LETTER BETA
+(cl-define-keysym #x07c3 "Greek_GAMMA") ;U+0393 GREEK CAPITAL LETTER GAMMA
+(cl-define-keysym #x07c4 "Greek_DELTA") ;U+0394 GREEK CAPITAL LETTER DELTA
+(cl-define-keysym #x07c5 "Greek_EPSILON") ;U+0395 GREEK CAPITAL LETTER EPSILON
+(cl-define-keysym #x07c6 "Greek_ZETA") ;U+0396 GREEK CAPITAL LETTER ZETA
+(cl-define-keysym #x07c7 "Greek_ETA") ;U+0397 GREEK CAPITAL LETTER ETA
+(cl-define-keysym #x07c8 "Greek_THETA") ;U+0398 GREEK CAPITAL LETTER THETA
+(cl-define-keysym #x07c9 "Greek_IOTA") ;U+0399 GREEK CAPITAL LETTER IOTA
+(cl-define-keysym #x07ca "Greek_KAPPA") ;U+039A GREEK CAPITAL LETTER KAPPA
+(cl-define-keysym #x07cb "Greek_LAMDA") ;U+039B GREEK CAPITAL LETTER LAMDA
+(cl-define-keysym #x07cb "Greek_LAMBDA") ;U+039B GREEK CAPITAL LETTER LAMDA
+(cl-define-keysym #x07cc "Greek_MU") ;U+039C GREEK CAPITAL LETTER MU
+(cl-define-keysym #x07cd "Greek_NU") ;U+039D GREEK CAPITAL LETTER NU
+(cl-define-keysym #x07ce "Greek_XI") ;U+039E GREEK CAPITAL LETTER XI
+(cl-define-keysym #x07cf "Greek_OMICRON") ;U+039F GREEK CAPITAL LETTER OMICRON
+(cl-define-keysym #x07d0 "Greek_PI") ;U+03A0 GREEK CAPITAL LETTER PI
+(cl-define-keysym #x07d1 "Greek_RHO") ;U+03A1 GREEK CAPITAL LETTER RHO
+(cl-define-keysym #x07d2 "Greek_SIGMA") ;U+03A3 GREEK CAPITAL LETTER SIGMA
+(cl-define-keysym #x07d4 "Greek_TAU") ;U+03A4 GREEK CAPITAL LETTER TAU
+(cl-define-keysym #x07d5 "Greek_UPSILON") ;U+03A5 GREEK CAPITAL LETTER UPSILON
+(cl-define-keysym #x07d6 "Greek_PHI") ;U+03A6 GREEK CAPITAL LETTER PHI
+(cl-define-keysym #x07d7 "Greek_CHI") ;U+03A7 GREEK CAPITAL LETTER CHI
+(cl-define-keysym #x07d8 "Greek_PSI") ;U+03A8 GREEK CAPITAL LETTER PSI
+(cl-define-keysym #x07d9 "Greek_OMEGA") ;U+03A9 GREEK CAPITAL LETTER OMEGA
+(cl-define-keysym #x07e1 "Greek_alpha") ;U+03B1 GREEK SMALL LETTER ALPHA
+(cl-define-keysym #x07e2 "Greek_beta") ;U+03B2 GREEK SMALL LETTER BETA
+(cl-define-keysym #x07e3 "Greek_gamma") ;U+03B3 GREEK SMALL LETTER GAMMA
+(cl-define-keysym #x07e4 "Greek_delta") ;U+03B4 GREEK SMALL LETTER DELTA
+(cl-define-keysym #x07e5 "Greek_epsilon") ;U+03B5 GREEK SMALL LETTER EPSILON
+(cl-define-keysym #x07e6 "Greek_zeta") ;U+03B6 GREEK SMALL LETTER ZETA
+(cl-define-keysym #x07e7 "Greek_eta") ;U+03B7 GREEK SMALL LETTER ETA
+(cl-define-keysym #x07e8 "Greek_theta") ;U+03B8 GREEK SMALL LETTER THETA
+(cl-define-keysym #x07e9 "Greek_iota") ;U+03B9 GREEK SMALL LETTER IOTA
+(cl-define-keysym #x07ea "Greek_kappa") ;U+03BA GREEK SMALL LETTER KAPPA
+(cl-define-keysym #x07eb "Greek_lamda") ;U+03BB GREEK SMALL LETTER LAMDA
+(cl-define-keysym #x07eb "Greek_lambda") ;U+03BB GREEK SMALL LETTER LAMDA
+(cl-define-keysym #x07ec "Greek_mu") ;U+03BC GREEK SMALL LETTER MU
+(cl-define-keysym #x07ed "Greek_nu") ;U+03BD GREEK SMALL LETTER NU
+(cl-define-keysym #x07ee "Greek_xi") ;U+03BE GREEK SMALL LETTER XI
+(cl-define-keysym #x07ef "Greek_omicron") ;U+03BF GREEK SMALL LETTER OMICRON
+(cl-define-keysym #x07f0 "Greek_pi") ;U+03C0 GREEK SMALL LETTER PI
+(cl-define-keysym #x07f1 "Greek_rho") ;U+03C1 GREEK SMALL LETTER RHO
+(cl-define-keysym #x07f2 "Greek_sigma") ;U+03C3 GREEK SMALL LETTER SIGMA
+(cl-define-keysym #x07f3 "Greek_finalsmallsigma") ;U+03C2 GREEK SMALL LETTER FINAL SIGMA
+(cl-define-keysym #x07f4 "Greek_tau") ;U+03C4 GREEK SMALL LETTER TAU
+(cl-define-keysym #x07f5 "Greek_upsilon") ;U+03C5 GREEK SMALL LETTER UPSILON
+(cl-define-keysym #x07f6 "Greek_phi") ;U+03C6 GREEK SMALL LETTER PHI
+(cl-define-keysym #x07f7 "Greek_chi") ;U+03C7 GREEK SMALL LETTER CHI
+(cl-define-keysym #x07f8 "Greek_psi") ;U+03C8 GREEK SMALL LETTER PSI
+(cl-define-keysym #x07f9 "Greek_omega") ;U+03C9 GREEK SMALL LETTER OMEGA
+(cl-define-keysym #xff7e "Greek_switch") ;Alias for mode_switch
+(cl-define-keysym #x08a1 "leftradical") ;U+23B7 RADICAL SYMBOL BOTTOM
+(cl-define-keysym #x08a2 "topleftradical") ;(U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT)
+(cl-define-keysym #x08a3 "horizconnector") ;(U+2500 BOX DRAWINGS LIGHT HORIZONTAL)
+(cl-define-keysym #x08a4 "topintegral") ;U+2320 TOP HALF INTEGRAL
+(cl-define-keysym #x08a5 "botintegral") ;U+2321 BOTTOM HALF INTEGRAL
+(cl-define-keysym #x08a6 "vertconnector") ;(U+2502 BOX DRAWINGS LIGHT VERTICAL)
+(cl-define-keysym #x08a7 "topleftsqbracket") ;U+23A1 LEFT SQUARE BRACKET UPPER CORNER
+(cl-define-keysym #x08a8 "botleftsqbracket") ;U+23A3 LEFT SQUARE BRACKET LOWER CORNER
+(cl-define-keysym #x08a9 "toprightsqbracket") ;U+23A4 RIGHT SQUARE BRACKET UPPER CORNER
+(cl-define-keysym #x08aa "botrightsqbracket") ;U+23A6 RIGHT SQUARE BRACKET LOWER CORNER
+(cl-define-keysym #x08ab "topleftparens") ;U+239B LEFT PARENTHESIS UPPER HOOK
+(cl-define-keysym #x08ac "botleftparens") ;U+239D LEFT PARENTHESIS LOWER HOOK
+(cl-define-keysym #x08ad "toprightparens") ;U+239E RIGHT PARENTHESIS UPPER HOOK
+(cl-define-keysym #x08ae "botrightparens") ;U+23A0 RIGHT PARENTHESIS LOWER HOOK
+(cl-define-keysym #x08af "leftmiddlecurlybrace") ;U+23A8 LEFT CURLY BRACKET MIDDLE PIECE
+(cl-define-keysym #x08b0 "rightmiddlecurlybrace") ;U+23AC RIGHT CURLY BRACKET MIDDLE PIECE
+(cl-define-keysym #x08b1 "topleftsummation")
+(cl-define-keysym #x08b2 "botleftsummation")
+(cl-define-keysym #x08b3 "topvertsummationconnector")
+(cl-define-keysym #x08b4 "botvertsummationconnector")
+(cl-define-keysym #x08b5 "toprightsummation")
+(cl-define-keysym #x08b6 "botrightsummation")
+(cl-define-keysym #x08b7 "rightmiddlesummation")
+(cl-define-keysym #x08bc "lessthanequal") ;U+2264 LESS-THAN OR EQUAL TO
+(cl-define-keysym #x08bd "notequal") ;U+2260 NOT EQUAL TO
+(cl-define-keysym #x08be "greaterthanequal") ;U+2265 GREATER-THAN OR EQUAL TO
+(cl-define-keysym #x08bf "integral") ;U+222B INTEGRAL
+(cl-define-keysym #x08c0 "therefore") ;U+2234 THEREFORE
+(cl-define-keysym #x08c1 "variation") ;U+221D PROPORTIONAL TO
+(cl-define-keysym #x08c2 "infinity") ;U+221E INFINITY
+(cl-define-keysym #x08c5 "nabla") ;U+2207 NABLA
+(cl-define-keysym #x08c8 "approximate") ;U+223C TILDE OPERATOR
+(cl-define-keysym #x08c9 "similarequal") ;U+2243 ASYMPTOTICALLY EQUAL TO
+(cl-define-keysym #x08cd "ifonlyif") ;U+21D4 LEFT RIGHT DOUBLE ARROW
+(cl-define-keysym #x08ce "implies") ;U+21D2 RIGHTWARDS DOUBLE ARROW
+(cl-define-keysym #x08cf "identical") ;U+2261 IDENTICAL TO
+(cl-define-keysym #x08d6 "radical") ;U+221A SQUARE ROOT
+(cl-define-keysym #x08da "includedin") ;U+2282 SUBSET OF
+(cl-define-keysym #x08db "includes") ;U+2283 SUPERSET OF
+(cl-define-keysym #x08dc "intersection") ;U+2229 INTERSECTION
+(cl-define-keysym #x08dd "union") ;U+222A UNION
+(cl-define-keysym #x08de "logicaland") ;U+2227 LOGICAL AND
+(cl-define-keysym #x08df "logicalor") ;U+2228 LOGICAL OR
+(cl-define-keysym #x08ef "partialderivative") ;U+2202 PARTIAL DIFFERENTIAL
+(cl-define-keysym #x08f6 "function") ;U+0192 LATIN SMALL LETTER F WITH HOOK
+(cl-define-keysym #x08fb "leftarrow") ;U+2190 LEFTWARDS ARROW
+(cl-define-keysym #x08fc "uparrow") ;U+2191 UPWARDS ARROW
+(cl-define-keysym #x08fd "rightarrow") ;U+2192 RIGHTWARDS ARROW
+(cl-define-keysym #x08fe "downarrow") ;U+2193 DOWNWARDS ARROW
+(cl-define-keysym #x09df "blank")
+(cl-define-keysym #x09e0 "soliddiamond") ;U+25C6 BLACK DIAMOND
+(cl-define-keysym #x09e1 "checkerboard") ;U+2592 MEDIUM SHADE
+(cl-define-keysym #x09e2 "ht") ;U+2409 SYMBOL FOR HORIZONTAL TABULATION
+(cl-define-keysym #x09e3 "ff") ;U+240C SYMBOL FOR FORM FEED
+(cl-define-keysym #x09e4 "cr") ;U+240D SYMBOL FOR CARRIAGE RETURN
+(cl-define-keysym #x09e5 "lf") ;U+240A SYMBOL FOR LINE FEED
+(cl-define-keysym #x09e8 "nl") ;U+2424 SYMBOL FOR NEWLINE
+(cl-define-keysym #x09e9 "vt") ;U+240B SYMBOL FOR VERTICAL TABULATION
+(cl-define-keysym #x09ea "lowrightcorner") ;U+2518 BOX DRAWINGS LIGHT UP AND LEFT
+(cl-define-keysym #x09eb "uprightcorner") ;U+2510 BOX DRAWINGS LIGHT DOWN AND LEFT
+(cl-define-keysym #x09ec "upleftcorner") ;U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT
+(cl-define-keysym #x09ed "lowleftcorner") ;U+2514 BOX DRAWINGS LIGHT UP AND RIGHT
+(cl-define-keysym #x09ee "crossinglines") ;U+253C BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+(cl-define-keysym #x09ef "horizlinescan1") ;U+23BA HORIZONTAL SCAN LINE-1
+(cl-define-keysym #x09f0 "horizlinescan3") ;U+23BB HORIZONTAL SCAN LINE-3
+(cl-define-keysym #x09f1 "horizlinescan5") ;U+2500 BOX DRAWINGS LIGHT HORIZONTAL
+(cl-define-keysym #x09f2 "horizlinescan7") ;U+23BC HORIZONTAL SCAN LINE-7
+(cl-define-keysym #x09f3 "horizlinescan9") ;U+23BD HORIZONTAL SCAN LINE-9
+(cl-define-keysym #x09f4 "leftt") ;U+251C BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+(cl-define-keysym #x09f5 "rightt") ;U+2524 BOX DRAWINGS LIGHT VERTICAL AND LEFT
+(cl-define-keysym #x09f6 "bott") ;U+2534 BOX DRAWINGS LIGHT UP AND HORIZONTAL
+(cl-define-keysym #x09f7 "topt") ;U+252C BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+(cl-define-keysym #x09f8 "vertbar") ;U+2502 BOX DRAWINGS LIGHT VERTICAL
+(cl-define-keysym #x0aa1 "emspace") ;U+2003 EM SPACE
+(cl-define-keysym #x0aa2 "enspace") ;U+2002 EN SPACE
+(cl-define-keysym #x0aa3 "em3space") ;U+2004 THREE-PER-EM SPACE
+(cl-define-keysym #x0aa4 "em4space") ;U+2005 FOUR-PER-EM SPACE
+(cl-define-keysym #x0aa5 "digitspace") ;U+2007 FIGURE SPACE
+(cl-define-keysym #x0aa6 "punctspace") ;U+2008 PUNCTUATION SPACE
+(cl-define-keysym #x0aa7 "thinspace") ;U+2009 THIN SPACE
+(cl-define-keysym #x0aa8 "hairspace") ;U+200A HAIR SPACE
+(cl-define-keysym #x0aa9 "emdash") ;U+2014 EM DASH
+(cl-define-keysym #x0aaa "endash") ;U+2013 EN DASH
+(cl-define-keysym #x0aac "signifblank") ;(U+2423 OPEN BOX)
+(cl-define-keysym #x0aae "ellipsis") ;U+2026 HORIZONTAL ELLIPSIS
+(cl-define-keysym #x0aaf "doubbaselinedot") ;U+2025 TWO DOT LEADER
+(cl-define-keysym #x0ab0 "onethird") ;U+2153 VULGAR FRACTION ONE THIRD
+(cl-define-keysym #x0ab1 "twothirds") ;U+2154 VULGAR FRACTION TWO THIRDS
+(cl-define-keysym #x0ab2 "onefifth") ;U+2155 VULGAR FRACTION ONE FIFTH
+(cl-define-keysym #x0ab3 "twofifths") ;U+2156 VULGAR FRACTION TWO FIFTHS
+(cl-define-keysym #x0ab4 "threefifths") ;U+2157 VULGAR FRACTION THREE FIFTHS
+(cl-define-keysym #x0ab5 "fourfifths") ;U+2158 VULGAR FRACTION FOUR FIFTHS
+(cl-define-keysym #x0ab6 "onesixth") ;U+2159 VULGAR FRACTION ONE SIXTH
+(cl-define-keysym #x0ab7 "fivesixths") ;U+215A VULGAR FRACTION FIVE SIXTHS
+(cl-define-keysym #x0ab8 "careof") ;U+2105 CARE OF
+(cl-define-keysym #x0abb "figdash") ;U+2012 FIGURE DASH
+(cl-define-keysym #x0abc "leftanglebracket") ;(U+27E8 MATHEMATICAL LEFT ANGLE BRACKET)
+(cl-define-keysym #x0abd "decimalpoint") ;(U+002E FULL STOP)
+(cl-define-keysym #x0abe "rightanglebracket") ;(U+27E9 MATHEMATICAL RIGHT ANGLE BRACKET)
+(cl-define-keysym #x0abf "marker")
+(cl-define-keysym #x0ac3 "oneeighth") ;U+215B VULGAR FRACTION ONE EIGHTH
+(cl-define-keysym #x0ac4 "threeeighths") ;U+215C VULGAR FRACTION THREE EIGHTHS
+(cl-define-keysym #x0ac5 "fiveeighths") ;U+215D VULGAR FRACTION FIVE EIGHTHS
+(cl-define-keysym #x0ac6 "seveneighths") ;U+215E VULGAR FRACTION SEVEN EIGHTHS
+(cl-define-keysym #x0ac9 "trademark") ;U+2122 TRADE MARK SIGN
+(cl-define-keysym #x0aca "signaturemark") ;(U+2613 SALTIRE)
+(cl-define-keysym #x0acb "trademarkincircle")
+(cl-define-keysym #x0acc "leftopentriangle") ;(U+25C1 WHITE LEFT-POINTING TRIANGLE)
+(cl-define-keysym #x0acd "rightopentriangle") ;(U+25B7 WHITE RIGHT-POINTING TRIANGLE)
+(cl-define-keysym #x0ace "emopencircle") ;(U+25CB WHITE CIRCLE)
+(cl-define-keysym #x0acf "emopenrectangle") ;(U+25AF WHITE VERTICAL RECTANGLE)
+(cl-define-keysym #x0ad0 "leftsinglequotemark") ;U+2018 LEFT SINGLE QUOTATION MARK
+(cl-define-keysym #x0ad1 "rightsinglequotemark") ;U+2019 RIGHT SINGLE QUOTATION MARK
+(cl-define-keysym #x0ad2 "leftdoublequotemark") ;U+201C LEFT DOUBLE QUOTATION MARK
+(cl-define-keysym #x0ad3 "rightdoublequotemark") ;U+201D RIGHT DOUBLE QUOTATION MARK
+(cl-define-keysym #x0ad4 "prescription") ;U+211E PRESCRIPTION TAKE
+(cl-define-keysym #x0ad6 "minutes") ;U+2032 PRIME
+(cl-define-keysym #x0ad7 "seconds") ;U+2033 DOUBLE PRIME
+(cl-define-keysym #x0ad9 "latincross") ;U+271D LATIN CROSS
+(cl-define-keysym #x0ada "hexagram")
+(cl-define-keysym #x0adb "filledrectbullet") ;(U+25AC BLACK RECTANGLE)
+(cl-define-keysym #x0adc "filledlefttribullet") ;(U+25C0 BLACK LEFT-POINTING TRIANGLE)
+(cl-define-keysym #x0add "filledrighttribullet") ;(U+25B6 BLACK RIGHT-POINTING TRIANGLE)
+(cl-define-keysym #x0ade "emfilledcircle") ;(U+25CF BLACK CIRCLE)
+(cl-define-keysym #x0adf "emfilledrect") ;(U+25AE BLACK VERTICAL RECTANGLE)
+(cl-define-keysym #x0ae0 "enopencircbullet") ;(U+25E6 WHITE BULLET)
+(cl-define-keysym #x0ae1 "enopensquarebullet") ;(U+25AB WHITE SMALL SQUARE)
+(cl-define-keysym #x0ae2 "openrectbullet") ;(U+25AD WHITE RECTANGLE)
+(cl-define-keysym #x0ae3 "opentribulletup") ;(U+25B3 WHITE UP-POINTING TRIANGLE)
+(cl-define-keysym #x0ae4 "opentribulletdown") ;(U+25BD WHITE DOWN-POINTING TRIANGLE)
+(cl-define-keysym #x0ae5 "openstar") ;(U+2606 WHITE STAR)
+(cl-define-keysym #x0ae6 "enfilledcircbullet") ;(U+2022 BULLET)
+(cl-define-keysym #x0ae7 "enfilledsqbullet") ;(U+25AA BLACK SMALL SQUARE)
+(cl-define-keysym #x0ae8 "filledtribulletup") ;(U+25B2 BLACK UP-POINTING TRIANGLE)
+(cl-define-keysym #x0ae9 "filledtribulletdown") ;(U+25BC BLACK DOWN-POINTING TRIANGLE)
+(cl-define-keysym #x0aea "leftpointer") ;(U+261C WHITE LEFT POINTING INDEX)
+(cl-define-keysym #x0aeb "rightpointer") ;(U+261E WHITE RIGHT POINTING INDEX)
+(cl-define-keysym #x0aec "club") ;U+2663 BLACK CLUB SUIT
+(cl-define-keysym #x0aed "diamond") ;U+2666 BLACK DIAMOND SUIT
+(cl-define-keysym #x0aee "heart") ;U+2665 BLACK HEART SUIT
+(cl-define-keysym #x0af0 "maltesecross") ;U+2720 MALTESE CROSS
+(cl-define-keysym #x0af1 "dagger") ;U+2020 DAGGER
+(cl-define-keysym #x0af2 "doubledagger") ;U+2021 DOUBLE DAGGER
+(cl-define-keysym #x0af3 "checkmark") ;U+2713 CHECK MARK
+(cl-define-keysym #x0af4 "ballotcross") ;U+2717 BALLOT X
+(cl-define-keysym #x0af5 "musicalsharp") ;U+266F MUSIC SHARP SIGN
+(cl-define-keysym #x0af6 "musicalflat") ;U+266D MUSIC FLAT SIGN
+(cl-define-keysym #x0af7 "malesymbol") ;U+2642 MALE SIGN
+(cl-define-keysym #x0af8 "femalesymbol") ;U+2640 FEMALE SIGN
+(cl-define-keysym #x0af9 "telephone") ;U+260E BLACK TELEPHONE
+(cl-define-keysym #x0afa "telephonerecorder") ;U+2315 TELEPHONE RECORDER
+(cl-define-keysym #x0afb "phonographcopyright") ;U+2117 SOUND RECORDING COPYRIGHT
+(cl-define-keysym #x0afc "caret") ;U+2038 CARET
+(cl-define-keysym #x0afd "singlelowquotemark") ;U+201A SINGLE LOW-9 QUOTATION MARK
+(cl-define-keysym #x0afe "doublelowquotemark") ;U+201E DOUBLE LOW-9 QUOTATION MARK
+(cl-define-keysym #x0aff "cursor")
+(cl-define-keysym #x0ba3 "leftcaret") ;(U+003C LESS-THAN SIGN)
+(cl-define-keysym #x0ba6 "rightcaret") ;(U+003E GREATER-THAN SIGN)
+(cl-define-keysym #x0ba8 "downcaret") ;(U+2228 LOGICAL OR)
+(cl-define-keysym #x0ba9 "upcaret") ;(U+2227 LOGICAL AND)
+(cl-define-keysym #x0bc0 "overbar") ;(U+00AF MACRON)
+(cl-define-keysym #x0bc2 "downtack") ;U+22A5 UP TACK
+(cl-define-keysym #x0bc3 "upshoe") ;(U+2229 INTERSECTION)
+(cl-define-keysym #x0bc4 "downstile") ;U+230A LEFT FLOOR
+(cl-define-keysym #x0bc6 "underbar") ;(U+005F LOW LINE)
+(cl-define-keysym #x0bca "jot") ;U+2218 RING OPERATOR
+(cl-define-keysym #x0bcc "quad") ;U+2395 APL FUNCTIONAL SYMBOL QUAD
+(cl-define-keysym #x0bce "uptack") ;U+22A4 DOWN TACK
+(cl-define-keysym #x0bcf "circle") ;U+25CB WHITE CIRCLE
+(cl-define-keysym #x0bd3 "upstile") ;U+2308 LEFT CEILING
+(cl-define-keysym #x0bd6 "downshoe") ;(U+222A UNION)
+(cl-define-keysym #x0bd8 "rightshoe") ;(U+2283 SUPERSET OF)
+(cl-define-keysym #x0bda "leftshoe") ;(U+2282 SUBSET OF)
+(cl-define-keysym #x0bdc "lefttack") ;U+22A2 RIGHT TACK
+(cl-define-keysym #x0bfc "righttack") ;U+22A3 LEFT TACK
+(cl-define-keysym #x0cdf "hebrew_doublelowline") ;U+2017 DOUBLE LOW LINE
+(cl-define-keysym #x0ce0 "hebrew_aleph") ;U+05D0 HEBREW LETTER ALEF
+(cl-define-keysym #x0ce1 "hebrew_bet") ;U+05D1 HEBREW LETTER BET
+(cl-define-keysym #x0ce1 "hebrew_beth") ;deprecated
+(cl-define-keysym #x0ce2 "hebrew_gimel") ;U+05D2 HEBREW LETTER GIMEL
+(cl-define-keysym #x0ce2 "hebrew_gimmel") ;deprecated
+(cl-define-keysym #x0ce3 "hebrew_dalet") ;U+05D3 HEBREW LETTER DALET
+(cl-define-keysym #x0ce3 "hebrew_daleth") ;deprecated
+(cl-define-keysym #x0ce4 "hebrew_he") ;U+05D4 HEBREW LETTER HE
+(cl-define-keysym #x0ce5 "hebrew_waw") ;U+05D5 HEBREW LETTER VAV
+(cl-define-keysym #x0ce6 "hebrew_zain") ;U+05D6 HEBREW LETTER ZAYIN
+(cl-define-keysym #x0ce6 "hebrew_zayin") ;deprecated
+(cl-define-keysym #x0ce7 "hebrew_chet") ;U+05D7 HEBREW LETTER HET
+(cl-define-keysym #x0ce7 "hebrew_het") ;deprecated
+(cl-define-keysym #x0ce8 "hebrew_tet") ;U+05D8 HEBREW LETTER TET
+(cl-define-keysym #x0ce8 "hebrew_teth") ;deprecated
+(cl-define-keysym #x0ce9 "hebrew_yod") ;U+05D9 HEBREW LETTER YOD
+(cl-define-keysym #x0cea "hebrew_finalkaph") ;U+05DA HEBREW LETTER FINAL KAF
+(cl-define-keysym #x0ceb "hebrew_kaph") ;U+05DB HEBREW LETTER KAF
+(cl-define-keysym #x0cec "hebrew_lamed") ;U+05DC HEBREW LETTER LAMED
+(cl-define-keysym #x0ced "hebrew_finalmem") ;U+05DD HEBREW LETTER FINAL MEM
+(cl-define-keysym #x0cee "hebrew_mem") ;U+05DE HEBREW LETTER MEM
+(cl-define-keysym #x0cef "hebrew_finalnun") ;U+05DF HEBREW LETTER FINAL NUN
+(cl-define-keysym #x0cf0 "hebrew_nun") ;U+05E0 HEBREW LETTER NUN
+(cl-define-keysym #x0cf1 "hebrew_samech") ;U+05E1 HEBREW LETTER SAMEKH
+(cl-define-keysym #x0cf1 "hebrew_samekh") ;deprecated
+(cl-define-keysym #x0cf2 "hebrew_ayin") ;U+05E2 HEBREW LETTER AYIN
+(cl-define-keysym #x0cf3 "hebrew_finalpe") ;U+05E3 HEBREW LETTER FINAL PE
+(cl-define-keysym #x0cf4 "hebrew_pe") ;U+05E4 HEBREW LETTER PE
+(cl-define-keysym #x0cf5 "hebrew_finalzade") ;U+05E5 HEBREW LETTER FINAL TSADI
+(cl-define-keysym #x0cf5 "hebrew_finalzadi") ;deprecated
+(cl-define-keysym #x0cf6 "hebrew_zade") ;U+05E6 HEBREW LETTER TSADI
+(cl-define-keysym #x0cf6 "hebrew_zadi") ;deprecated
+(cl-define-keysym #x0cf7 "hebrew_qoph") ;U+05E7 HEBREW LETTER QOF
+(cl-define-keysym #x0cf7 "hebrew_kuf") ;deprecated
+(cl-define-keysym #x0cf8 "hebrew_resh") ;U+05E8 HEBREW LETTER RESH
+(cl-define-keysym #x0cf9 "hebrew_shin") ;U+05E9 HEBREW LETTER SHIN
+(cl-define-keysym #x0cfa "hebrew_taw") ;U+05EA HEBREW LETTER TAV
+(cl-define-keysym #x0cfa "hebrew_taf") ;deprecated
+(cl-define-keysym #xff7e "Hebrew_switch") ;Alias for mode_switch
+(cl-define-keysym #x0da1 "Thai_kokai") ;U+0E01 THAI CHARACTER KO KAI
+(cl-define-keysym #x0da2 "Thai_khokhai") ;U+0E02 THAI CHARACTER KHO KHAI
+(cl-define-keysym #x0da3 "Thai_khokhuat") ;U+0E03 THAI CHARACTER KHO KHUAT
+(cl-define-keysym #x0da4 "Thai_khokhwai") ;U+0E04 THAI CHARACTER KHO KHWAI
+(cl-define-keysym #x0da5 "Thai_khokhon") ;U+0E05 THAI CHARACTER KHO KHON
+(cl-define-keysym #x0da6 "Thai_khorakhang") ;U+0E06 THAI CHARACTER KHO RAKHANG
+(cl-define-keysym #x0da7 "Thai_ngongu") ;U+0E07 THAI CHARACTER NGO NGU
+(cl-define-keysym #x0da8 "Thai_chochan") ;U+0E08 THAI CHARACTER CHO CHAN
+(cl-define-keysym #x0da9 "Thai_choching") ;U+0E09 THAI CHARACTER CHO CHING
+(cl-define-keysym #x0daa "Thai_chochang") ;U+0E0A THAI CHARACTER CHO CHANG
+(cl-define-keysym #x0dab "Thai_soso") ;U+0E0B THAI CHARACTER SO SO
+(cl-define-keysym #x0dac "Thai_chochoe") ;U+0E0C THAI CHARACTER CHO CHOE
+(cl-define-keysym #x0dad "Thai_yoying") ;U+0E0D THAI CHARACTER YO YING
+(cl-define-keysym #x0dae "Thai_dochada") ;U+0E0E THAI CHARACTER DO CHADA
+(cl-define-keysym #x0daf "Thai_topatak") ;U+0E0F THAI CHARACTER TO PATAK
+(cl-define-keysym #x0db0 "Thai_thothan") ;U+0E10 THAI CHARACTER THO THAN
+(cl-define-keysym #x0db1 "Thai_thonangmontho") ;U+0E11 THAI CHARACTER THO NANGMONTHO
+(cl-define-keysym #x0db2 "Thai_thophuthao") ;U+0E12 THAI CHARACTER THO PHUTHAO
+(cl-define-keysym #x0db3 "Thai_nonen") ;U+0E13 THAI CHARACTER NO NEN
+(cl-define-keysym #x0db4 "Thai_dodek") ;U+0E14 THAI CHARACTER DO DEK
+(cl-define-keysym #x0db5 "Thai_totao") ;U+0E15 THAI CHARACTER TO TAO
+(cl-define-keysym #x0db6 "Thai_thothung") ;U+0E16 THAI CHARACTER THO THUNG
+(cl-define-keysym #x0db7 "Thai_thothahan") ;U+0E17 THAI CHARACTER THO THAHAN
+(cl-define-keysym #x0db8 "Thai_thothong") ;U+0E18 THAI CHARACTER THO THONG
+(cl-define-keysym #x0db9 "Thai_nonu") ;U+0E19 THAI CHARACTER NO NU
+(cl-define-keysym #x0dba "Thai_bobaimai") ;U+0E1A THAI CHARACTER BO BAIMAI
+(cl-define-keysym #x0dbb "Thai_popla") ;U+0E1B THAI CHARACTER PO PLA
+(cl-define-keysym #x0dbc "Thai_phophung") ;U+0E1C THAI CHARACTER PHO PHUNG
+(cl-define-keysym #x0dbd "Thai_fofa") ;U+0E1D THAI CHARACTER FO FA
+(cl-define-keysym #x0dbe "Thai_phophan") ;U+0E1E THAI CHARACTER PHO PHAN
+(cl-define-keysym #x0dbf "Thai_fofan") ;U+0E1F THAI CHARACTER FO FAN
+(cl-define-keysym #x0dc0 "Thai_phosamphao") ;U+0E20 THAI CHARACTER PHO SAMPHAO
+(cl-define-keysym #x0dc1 "Thai_moma") ;U+0E21 THAI CHARACTER MO MA
+(cl-define-keysym #x0dc2 "Thai_yoyak") ;U+0E22 THAI CHARACTER YO YAK
+(cl-define-keysym #x0dc3 "Thai_rorua") ;U+0E23 THAI CHARACTER RO RUA
+(cl-define-keysym #x0dc4 "Thai_ru") ;U+0E24 THAI CHARACTER RU
+(cl-define-keysym #x0dc5 "Thai_loling") ;U+0E25 THAI CHARACTER LO LING
+(cl-define-keysym #x0dc6 "Thai_lu") ;U+0E26 THAI CHARACTER LU
+(cl-define-keysym #x0dc7 "Thai_wowaen") ;U+0E27 THAI CHARACTER WO WAEN
+(cl-define-keysym #x0dc8 "Thai_sosala") ;U+0E28 THAI CHARACTER SO SALA
+(cl-define-keysym #x0dc9 "Thai_sorusi") ;U+0E29 THAI CHARACTER SO RUSI
+(cl-define-keysym #x0dca "Thai_sosua") ;U+0E2A THAI CHARACTER SO SUA
+(cl-define-keysym #x0dcb "Thai_hohip") ;U+0E2B THAI CHARACTER HO HIP
+(cl-define-keysym #x0dcc "Thai_lochula") ;U+0E2C THAI CHARACTER LO CHULA
+(cl-define-keysym #x0dcd "Thai_oang") ;U+0E2D THAI CHARACTER O ANG
+(cl-define-keysym #x0dce "Thai_honokhuk") ;U+0E2E THAI CHARACTER HO NOKHUK
+(cl-define-keysym #x0dcf "Thai_paiyannoi") ;U+0E2F THAI CHARACTER PAIYANNOI
+(cl-define-keysym #x0dd0 "Thai_saraa") ;U+0E30 THAI CHARACTER SARA A
+(cl-define-keysym #x0dd1 "Thai_maihanakat") ;U+0E31 THAI CHARACTER MAI HAN-AKAT
+(cl-define-keysym #x0dd2 "Thai_saraaa") ;U+0E32 THAI CHARACTER SARA AA
+(cl-define-keysym #x0dd3 "Thai_saraam") ;U+0E33 THAI CHARACTER SARA AM
+(cl-define-keysym #x0dd4 "Thai_sarai") ;U+0E34 THAI CHARACTER SARA I
+(cl-define-keysym #x0dd5 "Thai_saraii") ;U+0E35 THAI CHARACTER SARA II
+(cl-define-keysym #x0dd6 "Thai_saraue") ;U+0E36 THAI CHARACTER SARA UE
+(cl-define-keysym #x0dd7 "Thai_sarauee") ;U+0E37 THAI CHARACTER SARA UEE
+(cl-define-keysym #x0dd8 "Thai_sarau") ;U+0E38 THAI CHARACTER SARA U
+(cl-define-keysym #x0dd9 "Thai_sarauu") ;U+0E39 THAI CHARACTER SARA UU
+(cl-define-keysym #x0dda "Thai_phinthu") ;U+0E3A THAI CHARACTER PHINTHU
+(cl-define-keysym #x0dde "Thai_maihanakat_maitho")
+(cl-define-keysym #x0ddf "Thai_baht") ;U+0E3F THAI CURRENCY SYMBOL BAHT
+(cl-define-keysym #x0de0 "Thai_sarae") ;U+0E40 THAI CHARACTER SARA E
+(cl-define-keysym #x0de1 "Thai_saraae") ;U+0E41 THAI CHARACTER SARA AE
+(cl-define-keysym #x0de2 "Thai_sarao") ;U+0E42 THAI CHARACTER SARA O
+(cl-define-keysym #x0de3 "Thai_saraaimaimuan") ;U+0E43 THAI CHARACTER SARA AI MAIMUAN
+(cl-define-keysym #x0de4 "Thai_saraaimaimalai") ;U+0E44 THAI CHARACTER SARA AI MAIMALAI
+(cl-define-keysym #x0de5 "Thai_lakkhangyao") ;U+0E45 THAI CHARACTER LAKKHANGYAO
+(cl-define-keysym #x0de6 "Thai_maiyamok") ;U+0E46 THAI CHARACTER MAIYAMOK
+(cl-define-keysym #x0de7 "Thai_maitaikhu") ;U+0E47 THAI CHARACTER MAITAIKHU
+(cl-define-keysym #x0de8 "Thai_maiek") ;U+0E48 THAI CHARACTER MAI EK
+(cl-define-keysym #x0de9 "Thai_maitho") ;U+0E49 THAI CHARACTER MAI THO
+(cl-define-keysym #x0dea "Thai_maitri") ;U+0E4A THAI CHARACTER MAI TRI
+(cl-define-keysym #x0deb "Thai_maichattawa") ;U+0E4B THAI CHARACTER MAI CHATTAWA
+(cl-define-keysym #x0dec "Thai_thanthakhat") ;U+0E4C THAI CHARACTER THANTHAKHAT
+(cl-define-keysym #x0ded "Thai_nikhahit") ;U+0E4D THAI CHARACTER NIKHAHIT
+(cl-define-keysym #x0df0 "Thai_leksun") ;U+0E50 THAI DIGIT ZERO
+(cl-define-keysym #x0df1 "Thai_leknung") ;U+0E51 THAI DIGIT ONE
+(cl-define-keysym #x0df2 "Thai_leksong") ;U+0E52 THAI DIGIT TWO
+(cl-define-keysym #x0df3 "Thai_leksam") ;U+0E53 THAI DIGIT THREE
+(cl-define-keysym #x0df4 "Thai_leksi") ;U+0E54 THAI DIGIT FOUR
+(cl-define-keysym #x0df5 "Thai_lekha") ;U+0E55 THAI DIGIT FIVE
+(cl-define-keysym #x0df6 "Thai_lekhok") ;U+0E56 THAI DIGIT SIX
+(cl-define-keysym #x0df7 "Thai_lekchet") ;U+0E57 THAI DIGIT SEVEN
+(cl-define-keysym #x0df8 "Thai_lekpaet") ;U+0E58 THAI DIGIT EIGHT
+(cl-define-keysym #x0df9 "Thai_lekkao") ;U+0E59 THAI DIGIT NINE
+(cl-define-keysym #xff31 "Hangul") ;Hangul start/stop(toggle)
+(cl-define-keysym #xff32 "Hangul_Start") ;Hangul start
+(cl-define-keysym #xff33 "Hangul_End") ;Hangul end, English start
+(cl-define-keysym #xff34 "Hangul_Hanja") ;Start Hangul->Hanja Conversion
+(cl-define-keysym #xff35 "Hangul_Jamo") ;Hangul Jamo mode
+(cl-define-keysym #xff36 "Hangul_Romaja") ;Hangul Romaja mode
+(cl-define-keysym #xff37 "Hangul_Codeinput") ;Hangul code input mode
+(cl-define-keysym #xff38 "Hangul_Jeonja") ;Jeonja mode
+(cl-define-keysym #xff39 "Hangul_Banja") ;Banja mode
+(cl-define-keysym #xff3a "Hangul_PreHanja") ;Pre Hanja conversion
+(cl-define-keysym #xff3b "Hangul_PostHanja") ;Post Hanja conversion
+(cl-define-keysym #xff3c "Hangul_SingleCandidate") ;Single candidate
+(cl-define-keysym #xff3d "Hangul_MultipleCandidate") ;Multiple candidate
+(cl-define-keysym #xff3e "Hangul_PreviousCandidate") ;Previous candidate
+(cl-define-keysym #xff3f "Hangul_Special") ;Special symbols
+(cl-define-keysym #xff7e "Hangul_switch") ;Alias for mode_switch
+(cl-define-keysym #x0ea1 "Hangul_Kiyeog")
+(cl-define-keysym #x0ea2 "Hangul_SsangKiyeog")
+(cl-define-keysym #x0ea3 "Hangul_KiyeogSios")
+(cl-define-keysym #x0ea4 "Hangul_Nieun")
+(cl-define-keysym #x0ea5 "Hangul_NieunJieuj")
+(cl-define-keysym #x0ea6 "Hangul_NieunHieuh")
+(cl-define-keysym #x0ea7 "Hangul_Dikeud")
+(cl-define-keysym #x0ea8 "Hangul_SsangDikeud")
+(cl-define-keysym #x0ea9 "Hangul_Rieul")
+(cl-define-keysym #x0eaa "Hangul_RieulKiyeog")
+(cl-define-keysym #x0eab "Hangul_RieulMieum")
+(cl-define-keysym #x0eac "Hangul_RieulPieub")
+(cl-define-keysym #x0ead "Hangul_RieulSios")
+(cl-define-keysym #x0eae "Hangul_RieulTieut")
+(cl-define-keysym #x0eaf "Hangul_RieulPhieuf")
+(cl-define-keysym #x0eb0 "Hangul_RieulHieuh")
+(cl-define-keysym #x0eb1 "Hangul_Mieum")
+(cl-define-keysym #x0eb2 "Hangul_Pieub")
+(cl-define-keysym #x0eb3 "Hangul_SsangPieub")
+(cl-define-keysym #x0eb4 "Hangul_PieubSios")
+(cl-define-keysym #x0eb5 "Hangul_Sios")
+(cl-define-keysym #x0eb6 "Hangul_SsangSios")
+(cl-define-keysym #x0eb7 "Hangul_Ieung")
+(cl-define-keysym #x0eb8 "Hangul_Jieuj")
+(cl-define-keysym #x0eb9 "Hangul_SsangJieuj")
+(cl-define-keysym #x0eba "Hangul_Cieuc")
+(cl-define-keysym #x0ebb "Hangul_Khieuq")
+(cl-define-keysym #x0ebc "Hangul_Tieut")
+(cl-define-keysym #x0ebd "Hangul_Phieuf")
+(cl-define-keysym #x0ebe "Hangul_Hieuh")
+(cl-define-keysym #x0ebf "Hangul_A")
+(cl-define-keysym #x0ec0 "Hangul_AE")
+(cl-define-keysym #x0ec1 "Hangul_YA")
+(cl-define-keysym #x0ec2 "Hangul_YAE")
+(cl-define-keysym #x0ec3 "Hangul_EO")
+(cl-define-keysym #x0ec4 "Hangul_E")
+(cl-define-keysym #x0ec5 "Hangul_YEO")
+(cl-define-keysym #x0ec6 "Hangul_YE")
+(cl-define-keysym #x0ec7 "Hangul_O")
+(cl-define-keysym #x0ec8 "Hangul_WA")
+(cl-define-keysym #x0ec9 "Hangul_WAE")
+(cl-define-keysym #x0eca "Hangul_OE")
+(cl-define-keysym #x0ecb "Hangul_YO")
+(cl-define-keysym #x0ecc "Hangul_U")
+(cl-define-keysym #x0ecd "Hangul_WEO")
+(cl-define-keysym #x0ece "Hangul_WE")
+(cl-define-keysym #x0ecf "Hangul_WI")
+(cl-define-keysym #x0ed0 "Hangul_YU")
+(cl-define-keysym #x0ed1 "Hangul_EU")
+(cl-define-keysym #x0ed2 "Hangul_YI")
+(cl-define-keysym #x0ed3 "Hangul_I")
+(cl-define-keysym #x0ed4 "Hangul_J_Kiyeog")
+(cl-define-keysym #x0ed5 "Hangul_J_SsangKiyeog")
+(cl-define-keysym #x0ed6 "Hangul_J_KiyeogSios")
+(cl-define-keysym #x0ed7 "Hangul_J_Nieun")
+(cl-define-keysym #x0ed8 "Hangul_J_NieunJieuj")
+(cl-define-keysym #x0ed9 "Hangul_J_NieunHieuh")
+(cl-define-keysym #x0eda "Hangul_J_Dikeud")
+(cl-define-keysym #x0edb "Hangul_J_Rieul")
+(cl-define-keysym #x0edc "Hangul_J_RieulKiyeog")
+(cl-define-keysym #x0edd "Hangul_J_RieulMieum")
+(cl-define-keysym #x0ede "Hangul_J_RieulPieub")
+(cl-define-keysym #x0edf "Hangul_J_RieulSios")
+(cl-define-keysym #x0ee0 "Hangul_J_RieulTieut")
+(cl-define-keysym #x0ee1 "Hangul_J_RieulPhieuf")
+(cl-define-keysym #x0ee2 "Hangul_J_RieulHieuh")
+(cl-define-keysym #x0ee3 "Hangul_J_Mieum")
+(cl-define-keysym #x0ee4 "Hangul_J_Pieub")
+(cl-define-keysym #x0ee5 "Hangul_J_PieubSios")
+(cl-define-keysym #x0ee6 "Hangul_J_Sios")
+(cl-define-keysym #x0ee7 "Hangul_J_SsangSios")
+(cl-define-keysym #x0ee8 "Hangul_J_Ieung")
+(cl-define-keysym #x0ee9 "Hangul_J_Jieuj")
+(cl-define-keysym #x0eea "Hangul_J_Cieuc")
+(cl-define-keysym #x0eeb "Hangul_J_Khieuq")
+(cl-define-keysym #x0eec "Hangul_J_Tieut")
+(cl-define-keysym #x0eed "Hangul_J_Phieuf")
+(cl-define-keysym #x0eee "Hangul_J_Hieuh")
+(cl-define-keysym #x0eef "Hangul_RieulYeorinHieuh")
+(cl-define-keysym #x0ef0 "Hangul_SunkyeongeumMieum")
+(cl-define-keysym #x0ef1 "Hangul_SunkyeongeumPieub")
+(cl-define-keysym #x0ef2 "Hangul_PanSios")
+(cl-define-keysym #x0ef3 "Hangul_KkogjiDalrinIeung")
+(cl-define-keysym #x0ef4 "Hangul_SunkyeongeumPhieuf")
+(cl-define-keysym #x0ef5 "Hangul_YeorinHieuh")
+(cl-define-keysym #x0ef6 "Hangul_AraeA")
+(cl-define-keysym #x0ef7 "Hangul_AraeAE")
+(cl-define-keysym #x0ef8 "Hangul_J_PanSios")
+(cl-define-keysym #x0ef9 "Hangul_J_KkogjiDalrinIeung")
+(cl-define-keysym #x0efa "Hangul_J_YeorinHieuh")
+(cl-define-keysym #x0eff "Korean_Won") ;(U+20A9 WON SIGN)
+(cl-define-keysym #x1000587 "Armenian_ligature_ew") ;U+0587 ARMENIAN SMALL LIGATURE ECH YIWN
+(cl-define-keysym #x1000589 "Armenian_full_stop") ;U+0589 ARMENIAN FULL STOP
+(cl-define-keysym #x1000589 "Armenian_verjaket") ;U+0589 ARMENIAN FULL STOP
+(cl-define-keysym #x100055d "Armenian_separation_mark") ;U+055D ARMENIAN COMMA
+(cl-define-keysym #x100055d "Armenian_but") ;U+055D ARMENIAN COMMA
+(cl-define-keysym #x100058a "Armenian_hyphen") ;U+058A ARMENIAN HYPHEN
+(cl-define-keysym #x100058a "Armenian_yentamna") ;U+058A ARMENIAN HYPHEN
+(cl-define-keysym #x100055c "Armenian_exclam") ;U+055C ARMENIAN EXCLAMATION MARK
+(cl-define-keysym #x100055c "Armenian_amanak") ;U+055C ARMENIAN EXCLAMATION MARK
+(cl-define-keysym #x100055b "Armenian_accent") ;U+055B ARMENIAN EMPHASIS MARK
+(cl-define-keysym #x100055b "Armenian_shesht") ;U+055B ARMENIAN EMPHASIS MARK
+(cl-define-keysym #x100055e "Armenian_question") ;U+055E ARMENIAN QUESTION MARK
+(cl-define-keysym #x100055e "Armenian_paruyk") ;U+055E ARMENIAN QUESTION MARK
+(cl-define-keysym #x1000531 "Armenian_AYB") ;U+0531 ARMENIAN CAPITAL LETTER AYB
+(cl-define-keysym #x1000561 "Armenian_ayb") ;U+0561 ARMENIAN SMALL LETTER AYB
+(cl-define-keysym #x1000532 "Armenian_BEN") ;U+0532 ARMENIAN CAPITAL LETTER BEN
+(cl-define-keysym #x1000562 "Armenian_ben") ;U+0562 ARMENIAN SMALL LETTER BEN
+(cl-define-keysym #x1000533 "Armenian_GIM") ;U+0533 ARMENIAN CAPITAL LETTER GIM
+(cl-define-keysym #x1000563 "Armenian_gim") ;U+0563 ARMENIAN SMALL LETTER GIM
+(cl-define-keysym #x1000534 "Armenian_DA") ;U+0534 ARMENIAN CAPITAL LETTER DA
+(cl-define-keysym #x1000564 "Armenian_da") ;U+0564 ARMENIAN SMALL LETTER DA
+(cl-define-keysym #x1000535 "Armenian_YECH") ;U+0535 ARMENIAN CAPITAL LETTER ECH
+(cl-define-keysym #x1000565 "Armenian_yech") ;U+0565 ARMENIAN SMALL LETTER ECH
+(cl-define-keysym #x1000536 "Armenian_ZA") ;U+0536 ARMENIAN CAPITAL LETTER ZA
+(cl-define-keysym #x1000566 "Armenian_za") ;U+0566 ARMENIAN SMALL LETTER ZA
+(cl-define-keysym #x1000537 "Armenian_E") ;U+0537 ARMENIAN CAPITAL LETTER EH
+(cl-define-keysym #x1000567 "Armenian_e") ;U+0567 ARMENIAN SMALL LETTER EH
+(cl-define-keysym #x1000538 "Armenian_AT") ;U+0538 ARMENIAN CAPITAL LETTER ET
+(cl-define-keysym #x1000568 "Armenian_at") ;U+0568 ARMENIAN SMALL LETTER ET
+(cl-define-keysym #x1000539 "Armenian_TO") ;U+0539 ARMENIAN CAPITAL LETTER TO
+(cl-define-keysym #x1000569 "Armenian_to") ;U+0569 ARMENIAN SMALL LETTER TO
+(cl-define-keysym #x100053a "Armenian_ZHE") ;U+053A ARMENIAN CAPITAL LETTER ZHE
+(cl-define-keysym #x100056a "Armenian_zhe") ;U+056A ARMENIAN SMALL LETTER ZHE
+(cl-define-keysym #x100053b "Armenian_INI") ;U+053B ARMENIAN CAPITAL LETTER INI
+(cl-define-keysym #x100056b "Armenian_ini") ;U+056B ARMENIAN SMALL LETTER INI
+(cl-define-keysym #x100053c "Armenian_LYUN") ;U+053C ARMENIAN CAPITAL LETTER LIWN
+(cl-define-keysym #x100056c "Armenian_lyun") ;U+056C ARMENIAN SMALL LETTER LIWN
+(cl-define-keysym #x100053d "Armenian_KHE") ;U+053D ARMENIAN CAPITAL LETTER XEH
+(cl-define-keysym #x100056d "Armenian_khe") ;U+056D ARMENIAN SMALL LETTER XEH
+(cl-define-keysym #x100053e "Armenian_TSA") ;U+053E ARMENIAN CAPITAL LETTER CA
+(cl-define-keysym #x100056e "Armenian_tsa") ;U+056E ARMENIAN SMALL LETTER CA
+(cl-define-keysym #x100053f "Armenian_KEN") ;U+053F ARMENIAN CAPITAL LETTER KEN
+(cl-define-keysym #x100056f "Armenian_ken") ;U+056F ARMENIAN SMALL LETTER KEN
+(cl-define-keysym #x1000540 "Armenian_HO") ;U+0540 ARMENIAN CAPITAL LETTER HO
+(cl-define-keysym #x1000570 "Armenian_ho") ;U+0570 ARMENIAN SMALL LETTER HO
+(cl-define-keysym #x1000541 "Armenian_DZA") ;U+0541 ARMENIAN CAPITAL LETTER JA
+(cl-define-keysym #x1000571 "Armenian_dza") ;U+0571 ARMENIAN SMALL LETTER JA
+(cl-define-keysym #x1000542 "Armenian_GHAT") ;U+0542 ARMENIAN CAPITAL LETTER GHAD
+(cl-define-keysym #x1000572 "Armenian_ghat") ;U+0572 ARMENIAN SMALL LETTER GHAD
+(cl-define-keysym #x1000543 "Armenian_TCHE") ;U+0543 ARMENIAN CAPITAL LETTER CHEH
+(cl-define-keysym #x1000573 "Armenian_tche") ;U+0573 ARMENIAN SMALL LETTER CHEH
+(cl-define-keysym #x1000544 "Armenian_MEN") ;U+0544 ARMENIAN CAPITAL LETTER MEN
+(cl-define-keysym #x1000574 "Armenian_men") ;U+0574 ARMENIAN SMALL LETTER MEN
+(cl-define-keysym #x1000545 "Armenian_HI") ;U+0545 ARMENIAN CAPITAL LETTER YI
+(cl-define-keysym #x1000575 "Armenian_hi") ;U+0575 ARMENIAN SMALL LETTER YI
+(cl-define-keysym #x1000546 "Armenian_NU") ;U+0546 ARMENIAN CAPITAL LETTER NOW
+(cl-define-keysym #x1000576 "Armenian_nu") ;U+0576 ARMENIAN SMALL LETTER NOW
+(cl-define-keysym #x1000547 "Armenian_SHA") ;U+0547 ARMENIAN CAPITAL LETTER SHA
+(cl-define-keysym #x1000577 "Armenian_sha") ;U+0577 ARMENIAN SMALL LETTER SHA
+(cl-define-keysym #x1000548 "Armenian_VO") ;U+0548 ARMENIAN CAPITAL LETTER VO
+(cl-define-keysym #x1000578 "Armenian_vo") ;U+0578 ARMENIAN SMALL LETTER VO
+(cl-define-keysym #x1000549 "Armenian_CHA") ;U+0549 ARMENIAN CAPITAL LETTER CHA
+(cl-define-keysym #x1000579 "Armenian_cha") ;U+0579 ARMENIAN SMALL LETTER CHA
+(cl-define-keysym #x100054a "Armenian_PE") ;U+054A ARMENIAN CAPITAL LETTER PEH
+(cl-define-keysym #x100057a "Armenian_pe") ;U+057A ARMENIAN SMALL LETTER PEH
+(cl-define-keysym #x100054b "Armenian_JE") ;U+054B ARMENIAN CAPITAL LETTER JHEH
+(cl-define-keysym #x100057b "Armenian_je") ;U+057B ARMENIAN SMALL LETTER JHEH
+(cl-define-keysym #x100054c "Armenian_RA") ;U+054C ARMENIAN CAPITAL LETTER RA
+(cl-define-keysym #x100057c "Armenian_ra") ;U+057C ARMENIAN SMALL LETTER RA
+(cl-define-keysym #x100054d "Armenian_SE") ;U+054D ARMENIAN CAPITAL LETTER SEH
+(cl-define-keysym #x100057d "Armenian_se") ;U+057D ARMENIAN SMALL LETTER SEH
+(cl-define-keysym #x100054e "Armenian_VEV") ;U+054E ARMENIAN CAPITAL LETTER VEW
+(cl-define-keysym #x100057e "Armenian_vev") ;U+057E ARMENIAN SMALL LETTER VEW
+(cl-define-keysym #x100054f "Armenian_TYUN") ;U+054F ARMENIAN CAPITAL LETTER TIWN
+(cl-define-keysym #x100057f "Armenian_tyun") ;U+057F ARMENIAN SMALL LETTER TIWN
+(cl-define-keysym #x1000550 "Armenian_RE") ;U+0550 ARMENIAN CAPITAL LETTER REH
+(cl-define-keysym #x1000580 "Armenian_re") ;U+0580 ARMENIAN SMALL LETTER REH
+(cl-define-keysym #x1000551 "Armenian_TSO") ;U+0551 ARMENIAN CAPITAL LETTER CO
+(cl-define-keysym #x1000581 "Armenian_tso") ;U+0581 ARMENIAN SMALL LETTER CO
+(cl-define-keysym #x1000552 "Armenian_VYUN") ;U+0552 ARMENIAN CAPITAL LETTER YIWN
+(cl-define-keysym #x1000582 "Armenian_vyun") ;U+0582 ARMENIAN SMALL LETTER YIWN
+(cl-define-keysym #x1000553 "Armenian_PYUR") ;U+0553 ARMENIAN CAPITAL LETTER PIWR
+(cl-define-keysym #x1000583 "Armenian_pyur") ;U+0583 ARMENIAN SMALL LETTER PIWR
+(cl-define-keysym #x1000554 "Armenian_KE") ;U+0554 ARMENIAN CAPITAL LETTER KEH
+(cl-define-keysym #x1000584 "Armenian_ke") ;U+0584 ARMENIAN SMALL LETTER KEH
+(cl-define-keysym #x1000555 "Armenian_O") ;U+0555 ARMENIAN CAPITAL LETTER OH
+(cl-define-keysym #x1000585 "Armenian_o") ;U+0585 ARMENIAN SMALL LETTER OH
+(cl-define-keysym #x1000556 "Armenian_FE") ;U+0556 ARMENIAN CAPITAL LETTER FEH
+(cl-define-keysym #x1000586 "Armenian_fe") ;U+0586 ARMENIAN SMALL LETTER FEH
+(cl-define-keysym #x100055a "Armenian_apostrophe") ;U+055A ARMENIAN APOSTROPHE
+(cl-define-keysym #x10010d0 "Georgian_an") ;U+10D0 GEORGIAN LETTER AN
+(cl-define-keysym #x10010d1 "Georgian_ban") ;U+10D1 GEORGIAN LETTER BAN
+(cl-define-keysym #x10010d2 "Georgian_gan") ;U+10D2 GEORGIAN LETTER GAN
+(cl-define-keysym #x10010d3 "Georgian_don") ;U+10D3 GEORGIAN LETTER DON
+(cl-define-keysym #x10010d4 "Georgian_en") ;U+10D4 GEORGIAN LETTER EN
+(cl-define-keysym #x10010d5 "Georgian_vin") ;U+10D5 GEORGIAN LETTER VIN
+(cl-define-keysym #x10010d6 "Georgian_zen") ;U+10D6 GEORGIAN LETTER ZEN
+(cl-define-keysym #x10010d7 "Georgian_tan") ;U+10D7 GEORGIAN LETTER TAN
+(cl-define-keysym #x10010d8 "Georgian_in") ;U+10D8 GEORGIAN LETTER IN
+(cl-define-keysym #x10010d9 "Georgian_kan") ;U+10D9 GEORGIAN LETTER KAN
+(cl-define-keysym #x10010da "Georgian_las") ;U+10DA GEORGIAN LETTER LAS
+(cl-define-keysym #x10010db "Georgian_man") ;U+10DB GEORGIAN LETTER MAN
+(cl-define-keysym #x10010dc "Georgian_nar") ;U+10DC GEORGIAN LETTER NAR
+(cl-define-keysym #x10010dd "Georgian_on") ;U+10DD GEORGIAN LETTER ON
+(cl-define-keysym #x10010de "Georgian_par") ;U+10DE GEORGIAN LETTER PAR
+(cl-define-keysym #x10010df "Georgian_zhar") ;U+10DF GEORGIAN LETTER ZHAR
+(cl-define-keysym #x10010e0 "Georgian_rae") ;U+10E0 GEORGIAN LETTER RAE
+(cl-define-keysym #x10010e1 "Georgian_san") ;U+10E1 GEORGIAN LETTER SAN
+(cl-define-keysym #x10010e2 "Georgian_tar") ;U+10E2 GEORGIAN LETTER TAR
+(cl-define-keysym #x10010e3 "Georgian_un") ;U+10E3 GEORGIAN LETTER UN
+(cl-define-keysym #x10010e4 "Georgian_phar") ;U+10E4 GEORGIAN LETTER PHAR
+(cl-define-keysym #x10010e5 "Georgian_khar") ;U+10E5 GEORGIAN LETTER KHAR
+(cl-define-keysym #x10010e6 "Georgian_ghan") ;U+10E6 GEORGIAN LETTER GHAN
+(cl-define-keysym #x10010e7 "Georgian_qar") ;U+10E7 GEORGIAN LETTER QAR
+(cl-define-keysym #x10010e8 "Georgian_shin") ;U+10E8 GEORGIAN LETTER SHIN
+(cl-define-keysym #x10010e9 "Georgian_chin") ;U+10E9 GEORGIAN LETTER CHIN
+(cl-define-keysym #x10010ea "Georgian_can") ;U+10EA GEORGIAN LETTER CAN
+(cl-define-keysym #x10010eb "Georgian_jil") ;U+10EB GEORGIAN LETTER JIL
+(cl-define-keysym #x10010ec "Georgian_cil") ;U+10EC GEORGIAN LETTER CIL
+(cl-define-keysym #x10010ed "Georgian_char") ;U+10ED GEORGIAN LETTER CHAR
+(cl-define-keysym #x10010ee "Georgian_xan") ;U+10EE GEORGIAN LETTER XAN
+(cl-define-keysym #x10010ef "Georgian_jhan") ;U+10EF GEORGIAN LETTER JHAN
+(cl-define-keysym #x10010f0 "Georgian_hae") ;U+10F0 GEORGIAN LETTER HAE
+(cl-define-keysym #x10010f1 "Georgian_he") ;U+10F1 GEORGIAN LETTER HE
+(cl-define-keysym #x10010f2 "Georgian_hie") ;U+10F2 GEORGIAN LETTER HIE
+(cl-define-keysym #x10010f3 "Georgian_we") ;U+10F3 GEORGIAN LETTER WE
+(cl-define-keysym #x10010f4 "Georgian_har") ;U+10F4 GEORGIAN LETTER HAR
+(cl-define-keysym #x10010f5 "Georgian_hoe") ;U+10F5 GEORGIAN LETTER HOE
+(cl-define-keysym #x10010f6 "Georgian_fi") ;U+10F6 GEORGIAN LETTER FI
+(cl-define-keysym #x1001e8a "Xabovedot") ;U+1E8A LATIN CAPITAL LETTER X WITH DOT ABOVE
+(cl-define-keysym #x100012c "Ibreve") ;U+012C LATIN CAPITAL LETTER I WITH BREVE
+(cl-define-keysym #x10001b5 "Zstroke") ;U+01B5 LATIN CAPITAL LETTER Z WITH STROKE
+(cl-define-keysym #x10001e6 "Gcaron") ;U+01E6 LATIN CAPITAL LETTER G WITH CARON
+(cl-define-keysym #x10001d1 "Ocaron") ;U+01D2 LATIN CAPITAL LETTER O WITH CARON
+(cl-define-keysym #x100019f "Obarred") ;U+019F LATIN CAPITAL LETTER O WITH MIDDLE TILDE
+(cl-define-keysym #x1001e8b "xabovedot") ;U+1E8B LATIN SMALL LETTER X WITH DOT ABOVE
+(cl-define-keysym #x100012d "ibreve") ;U+012D LATIN SMALL LETTER I WITH BREVE
+(cl-define-keysym #x10001b6 "zstroke") ;U+01B6 LATIN SMALL LETTER Z WITH STROKE
+(cl-define-keysym #x10001e7 "gcaron") ;U+01E7 LATIN SMALL LETTER G WITH CARON
+(cl-define-keysym #x10001d2 "ocaron") ;U+01D2 LATIN SMALL LETTER O WITH CARON
+(cl-define-keysym #x1000275 "obarred") ;U+0275 LATIN SMALL LETTER BARRED O
+(cl-define-keysym #x100018f "SCHWA") ;U+018F LATIN CAPITAL LETTER SCHWA
+(cl-define-keysym #x1000259 "schwa") ;U+0259 LATIN SMALL LETTER SCHWA
+(cl-define-keysym #x1001e36 "Lbelowdot") ;U+1E36 LATIN CAPITAL LETTER L WITH DOT BELOW
+(cl-define-keysym #x1001e37 "lbelowdot") ;U+1E37 LATIN SMALL LETTER L WITH DOT BELOW
+(cl-define-keysym #x1001ea0 "Abelowdot") ;U+1EA0 LATIN CAPITAL LETTER A WITH DOT BELOW
+(cl-define-keysym #x1001ea1 "abelowdot") ;U+1EA1 LATIN SMALL LETTER A WITH DOT BELOW
+(cl-define-keysym #x1001ea2 "Ahook") ;U+1EA2 LATIN CAPITAL LETTER A WITH HOOK ABOVE
+(cl-define-keysym #x1001ea3 "ahook") ;U+1EA3 LATIN SMALL LETTER A WITH HOOK ABOVE
+(cl-define-keysym #x1001ea4 "Acircumflexacute") ;U+1EA4 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ea5 "acircumflexacute") ;U+1EA5 LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ea6 "Acircumflexgrave") ;U+1EA6 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ea7 "acircumflexgrave") ;U+1EA7 LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ea8 "Acircumflexhook") ;U+1EA8 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001ea9 "acircumflexhook") ;U+1EA9 LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001eaa "Acircumflextilde") ;U+1EAA LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001eab "acircumflextilde") ;U+1EAB LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001eac "Acircumflexbelowdot") ;U+1EAC LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001ead "acircumflexbelowdot") ;U+1EAD LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001eae "Abreveacute") ;U+1EAE LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+(cl-define-keysym #x1001eaf "abreveacute") ;U+1EAF LATIN SMALL LETTER A WITH BREVE AND ACUTE
+(cl-define-keysym #x1001eb0 "Abrevegrave") ;U+1EB0 LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+(cl-define-keysym #x1001eb1 "abrevegrave") ;U+1EB1 LATIN SMALL LETTER A WITH BREVE AND GRAVE
+(cl-define-keysym #x1001eb2 "Abrevehook") ;U+1EB2 LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
+(cl-define-keysym #x1001eb3 "abrevehook") ;U+1EB3 LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+(cl-define-keysym #x1001eb4 "Abrevetilde") ;U+1EB4 LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+(cl-define-keysym #x1001eb5 "abrevetilde") ;U+1EB5 LATIN SMALL LETTER A WITH BREVE AND TILDE
+(cl-define-keysym #x1001eb6 "Abrevebelowdot") ;U+1EB6 LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+(cl-define-keysym #x1001eb7 "abrevebelowdot") ;U+1EB7 LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+(cl-define-keysym #x1001eb8 "Ebelowdot") ;U+1EB8 LATIN CAPITAL LETTER E WITH DOT BELOW
+(cl-define-keysym #x1001eb9 "ebelowdot") ;U+1EB9 LATIN SMALL LETTER E WITH DOT BELOW
+(cl-define-keysym #x1001eba "Ehook") ;U+1EBA LATIN CAPITAL LETTER E WITH HOOK ABOVE
+(cl-define-keysym #x1001ebb "ehook") ;U+1EBB LATIN SMALL LETTER E WITH HOOK ABOVE
+(cl-define-keysym #x1001ebc "Etilde") ;U+1EBC LATIN CAPITAL LETTER E WITH TILDE
+(cl-define-keysym #x1001ebd "etilde") ;U+1EBD LATIN SMALL LETTER E WITH TILDE
+(cl-define-keysym #x1001ebe "Ecircumflexacute") ;U+1EBE LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ebf "ecircumflexacute") ;U+1EBF LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ec0 "Ecircumflexgrave") ;U+1EC0 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ec1 "ecircumflexgrave") ;U+1EC1 LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ec2 "Ecircumflexhook") ;U+1EC2 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001ec3 "ecircumflexhook") ;U+1EC3 LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001ec4 "Ecircumflextilde") ;U+1EC4 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001ec5 "ecircumflextilde") ;U+1EC5 LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001ec6 "Ecircumflexbelowdot") ;U+1EC6 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001ec7 "ecircumflexbelowdot") ;U+1EC7 LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001ec8 "Ihook") ;U+1EC8 LATIN CAPITAL LETTER I WITH HOOK ABOVE
+(cl-define-keysym #x1001ec9 "ihook") ;U+1EC9 LATIN SMALL LETTER I WITH HOOK ABOVE
+(cl-define-keysym #x1001eca "Ibelowdot") ;U+1ECA LATIN CAPITAL LETTER I WITH DOT BELOW
+(cl-define-keysym #x1001ecb "ibelowdot") ;U+1ECB LATIN SMALL LETTER I WITH DOT BELOW
+(cl-define-keysym #x1001ecc "Obelowdot") ;U+1ECC LATIN CAPITAL LETTER O WITH DOT BELOW
+(cl-define-keysym #x1001ecd "obelowdot") ;U+1ECD LATIN SMALL LETTER O WITH DOT BELOW
+(cl-define-keysym #x1001ece "Ohook") ;U+1ECE LATIN CAPITAL LETTER O WITH HOOK ABOVE
+(cl-define-keysym #x1001ecf "ohook") ;U+1ECF LATIN SMALL LETTER O WITH HOOK ABOVE
+(cl-define-keysym #x1001ed0 "Ocircumflexacute") ;U+1ED0 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ed1 "ocircumflexacute") ;U+1ED1 LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+(cl-define-keysym #x1001ed2 "Ocircumflexgrave") ;U+1ED2 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ed3 "ocircumflexgrave") ;U+1ED3 LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+(cl-define-keysym #x1001ed4 "Ocircumflexhook") ;U+1ED4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001ed5 "ocircumflexhook") ;U+1ED5 LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+(cl-define-keysym #x1001ed6 "Ocircumflextilde") ;U+1ED6 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001ed7 "ocircumflextilde") ;U+1ED7 LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+(cl-define-keysym #x1001ed8 "Ocircumflexbelowdot") ;U+1ED8 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001ed9 "ocircumflexbelowdot") ;U+1ED9 LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+(cl-define-keysym #x1001eda "Ohornacute") ;U+1EDA LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+(cl-define-keysym #x1001edb "ohornacute") ;U+1EDB LATIN SMALL LETTER O WITH HORN AND ACUTE
+(cl-define-keysym #x1001edc "Ohorngrave") ;U+1EDC LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+(cl-define-keysym #x1001edd "ohorngrave") ;U+1EDD LATIN SMALL LETTER O WITH HORN AND GRAVE
+(cl-define-keysym #x1001ede "Ohornhook") ;U+1EDE LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
+(cl-define-keysym #x1001edf "ohornhook") ;U+1EDF LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+(cl-define-keysym #x1001ee0 "Ohorntilde") ;U+1EE0 LATIN CAPITAL LETTER O WITH HORN AND TILDE
+(cl-define-keysym #x1001ee1 "ohorntilde") ;U+1EE1 LATIN SMALL LETTER O WITH HORN AND TILDE
+(cl-define-keysym #x1001ee2 "Ohornbelowdot") ;U+1EE2 LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW
+(cl-define-keysym #x1001ee3 "ohornbelowdot") ;U+1EE3 LATIN SMALL LETTER O WITH HORN AND DOT BELOW
+(cl-define-keysym #x1001ee4 "Ubelowdot") ;U+1EE4 LATIN CAPITAL LETTER U WITH DOT BELOW
+(cl-define-keysym #x1001ee5 "ubelowdot") ;U+1EE5 LATIN SMALL LETTER U WITH DOT BELOW
+(cl-define-keysym #x1001ee6 "Uhook") ;U+1EE6 LATIN CAPITAL LETTER U WITH HOOK ABOVE
+(cl-define-keysym #x1001ee7 "uhook") ;U+1EE7 LATIN SMALL LETTER U WITH HOOK ABOVE
+(cl-define-keysym #x1001ee8 "Uhornacute") ;U+1EE8 LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+(cl-define-keysym #x1001ee9 "uhornacute") ;U+1EE9 LATIN SMALL LETTER U WITH HORN AND ACUTE
+(cl-define-keysym #x1001eea "Uhorngrave") ;U+1EEA LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+(cl-define-keysym #x1001eeb "uhorngrave") ;U+1EEB LATIN SMALL LETTER U WITH HORN AND GRAVE
+(cl-define-keysym #x1001eec "Uhornhook") ;U+1EEC LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
+(cl-define-keysym #x1001eed "uhornhook") ;U+1EED LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+(cl-define-keysym #x1001eee "Uhorntilde") ;U+1EEE LATIN CAPITAL LETTER U WITH HORN AND TILDE
+(cl-define-keysym #x1001eef "uhorntilde") ;U+1EEF LATIN SMALL LETTER U WITH HORN AND TILDE
+(cl-define-keysym #x1001ef0 "Uhornbelowdot") ;U+1EF0 LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW
+(cl-define-keysym #x1001ef1 "uhornbelowdot") ;U+1EF1 LATIN SMALL LETTER U WITH HORN AND DOT BELOW
+(cl-define-keysym #x1001ef4 "Ybelowdot") ;U+1EF4 LATIN CAPITAL LETTER Y WITH DOT BELOW
+(cl-define-keysym #x1001ef5 "ybelowdot") ;U+1EF5 LATIN SMALL LETTER Y WITH DOT BELOW
+(cl-define-keysym #x1001ef6 "Yhook") ;U+1EF6 LATIN CAPITAL LETTER Y WITH HOOK ABOVE
+(cl-define-keysym #x1001ef7 "yhook") ;U+1EF7 LATIN SMALL LETTER Y WITH HOOK ABOVE
+(cl-define-keysym #x1001ef8 "Ytilde") ;U+1EF8 LATIN CAPITAL LETTER Y WITH TILDE
+(cl-define-keysym #x1001ef9 "ytilde") ;U+1EF9 LATIN SMALL LETTER Y WITH TILDE
+(cl-define-keysym #x10001a0 "Ohorn") ;U+01A0 LATIN CAPITAL LETTER O WITH HORN
+(cl-define-keysym #x10001a1 "ohorn") ;U+01A1 LATIN SMALL LETTER O WITH HORN
+(cl-define-keysym #x10001af "Uhorn") ;U+01AF LATIN CAPITAL LETTER U WITH HORN
+(cl-define-keysym #x10001b0 "uhorn") ;U+01B0 LATIN SMALL LETTER U WITH HORN
+(cl-define-keysym #x10020a0 "EcuSign") ;U+20A0 EURO-CURRENCY SIGN
+(cl-define-keysym #x10020a1 "ColonSign") ;U+20A1 COLON SIGN
+(cl-define-keysym #x10020a2 "CruzeiroSign") ;U+20A2 CRUZEIRO SIGN
+(cl-define-keysym #x10020a3 "FFrancSign") ;U+20A3 FRENCH FRANC SIGN
+(cl-define-keysym #x10020a4 "LiraSign") ;U+20A4 LIRA SIGN
+(cl-define-keysym #x10020a5 "MillSign") ;U+20A5 MILL SIGN
+(cl-define-keysym #x10020a6 "NairaSign") ;U+20A6 NAIRA SIGN
+(cl-define-keysym #x10020a7 "PesetaSign") ;U+20A7 PESETA SIGN
+(cl-define-keysym #x10020a8 "RupeeSign") ;U+20A8 RUPEE SIGN
+(cl-define-keysym #x10020a9 "WonSign") ;U+20A9 WON SIGN
+(cl-define-keysym #x10020aa "NewSheqelSign") ;U+20AA NEW SHEQEL SIGN
+(cl-define-keysym #x10020ab "DongSign") ;U+20AB DONG SIGN
+(cl-define-keysym #x20ac "EuroSign") ;U+20AC EURO SIGN
+(cl-define-keysym #x1002070 "zerosuperior") ;U+2070 SUPERSCRIPT ZERO
+(cl-define-keysym #x1002074 "foursuperior") ;U+2074 SUPERSCRIPT FOUR
+(cl-define-keysym #x1002075 "fivesuperior") ;U+2075 SUPERSCRIPT FIVE
+(cl-define-keysym #x1002076 "sixsuperior") ;U+2076 SUPERSCRIPT SIX
+(cl-define-keysym #x1002077 "sevensuperior") ;U+2077 SUPERSCRIPT SEVEN
+(cl-define-keysym #x1002078 "eightsuperior") ;U+2078 SUPERSCRIPT EIGHT
+(cl-define-keysym #x1002079 "ninesuperior") ;U+2079 SUPERSCRIPT NINE
+(cl-define-keysym #x1002080 "zerosubscript") ;U+2080 SUBSCRIPT ZERO
+(cl-define-keysym #x1002081 "onesubscript") ;U+2081 SUBSCRIPT ONE
+(cl-define-keysym #x1002082 "twosubscript") ;U+2082 SUBSCRIPT TWO
+(cl-define-keysym #x1002083 "threesubscript") ;U+2083 SUBSCRIPT THREE
+(cl-define-keysym #x1002084 "foursubscript") ;U+2084 SUBSCRIPT FOUR
+(cl-define-keysym #x1002085 "fivesubscript") ;U+2085 SUBSCRIPT FIVE
+(cl-define-keysym #x1002086 "sixsubscript") ;U+2086 SUBSCRIPT SIX
+(cl-define-keysym #x1002087 "sevensubscript") ;U+2087 SUBSCRIPT SEVEN
+(cl-define-keysym #x1002088 "eightsubscript") ;U+2088 SUBSCRIPT EIGHT
+(cl-define-keysym #x1002089 "ninesubscript") ;U+2089 SUBSCRIPT NINE
+(cl-define-keysym #x1002202 "partdifferential") ;U+2202 PARTIAL DIFFERENTIAL
+(cl-define-keysym #x1002205 "emptyset") ;U+2205 NULL SET
+(cl-define-keysym #x1002208 "elementof") ;U+2208 ELEMENT OF
+(cl-define-keysym #x1002209 "notelementof") ;U+2209 NOT AN ELEMENT OF
+(cl-define-keysym #x100220B "containsas") ;U+220B CONTAINS AS MEMBER
+(cl-define-keysym #x100221A "squareroot") ;U+221A SQUARE ROOT
+(cl-define-keysym #x100221B "cuberoot") ;U+221B CUBE ROOT
+(cl-define-keysym #x100221C "fourthroot") ;U+221C FOURTH ROOT
+(cl-define-keysym #x100222C "dintegral") ;U+222C DOUBLE INTEGRAL
+(cl-define-keysym #x100222D "tintegral") ;U+222D TRIPLE INTEGRAL
+(cl-define-keysym #x1002235 "because") ;U+2235 BECAUSE
+(cl-define-keysym #x1002248 "approxeq") ;U+2245 ALMOST EQUAL TO
+(cl-define-keysym #x1002247 "notapproxeq") ;U+2247 NOT ALMOST EQUAL TO
+(cl-define-keysym #x1002262 "notidentical") ;U+2262 NOT IDENTICAL TO
+(cl-define-keysym #x1002263 "stricteq") ;U+2263 STRICTLY EQUIVALENT TO
Added: clfswm/load.lisp
==============================================================================
--- (empty file)
+++ clfswm/load.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,59 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 26 23:00:22 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: System loading functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+
+(defparameter *base-dir* (directory-namestring *load-truename*))
+
+#+CMU
+(setf ext:*gc-verbose* nil)
+
+#+CMU
+(require :clx)
+
+#+SBCL
+(require :asdf)
+
+#+SBCL
+(require :sb-posix)
+
+#+SBCL
+(require :clx)
+
+#-ASDF
+(load (make-pathname :host (pathname-host *base-dir*)
+ :device (pathname-device *base-dir*)
+ :directory (pathname-directory *base-dir*)
+ :name "asdf" :type "lisp"))
+
+(push *base-dir* asdf:*central-registry*)
+
+
+(asdf:oos 'asdf:load-op :clfswm)
+
+(in-package :clfswm)
+
+(clfswm:main ":0")
Added: clfswm/my-html.lisp
==============================================================================
--- (empty file)
+++ clfswm/my-html.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,123 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Fri Dec 21 23:00:35 2007
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Html generator helper
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+
+
+(in-package :common-lisp-user)
+
+(defpackage :my-html
+ (:use :common-lisp :tools)
+ (:export :insert-html-doctype
+ :produce-html
+ :with-html
+ :produce-html-string))
+
+(in-package :my-html)
+
+
+(defun insert-html-doctype ()
+ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+ \"http://www.w3.org/TR/html4/transitional.dtd\">")
+
+
+
+(defun produce-html (tree &optional (level 0) (stream *standard-output*))
+ (cond ((listp tree)
+ (print-space level stream)
+ (format stream "~(<~A>~)~%" (first tree))
+ (dolist (subtree (rest tree))
+ (produce-html subtree (+ 2 level) stream))
+ (print-space level stream)
+ (format stream "~(</~A>~)~%"
+ (if (stringp (first tree))
+ (subseq (first tree) 0 (position #\Space (first tree)))
+ (first tree))))
+ (t
+ (print-space level stream)
+ (format stream (if (stringp tree) "~A~%" "~(~A~)~%") tree))))
+
+
+(defmacro with-html ((&optional (stream t)) &rest rest)
+ `(produce-html ', at rest 0 ,stream))
+
+
+(defun produce-html-string (tree &optional (level 0))
+ (with-output-to-string (str)
+ (produce-html tree level str)))
+
+
+
+
+(defun test1 ()
+ (produce-html `(html
+ (head
+ (title "Plop"))
+ (body
+ (h1 "A title")
+ (h2 "plop")
+ Plop ,(+ 2 2)
+ ,(format nil "Plip=~A" (+ 3 5))
+ ("a href=\"index.html\"" index)
+ (ul
+ (li "toto")
+ (li "klm"))))))
+
+
+(defun test2 ()
+ (with-html ()
+ (html
+ (head
+ (title "Plop"))
+ "<img src=\"toto.png\">"
+ (body
+ (h1 "Un titre")
+ (h2 "plop")
+ (ul
+ (li "toto")
+ (li "klm"))))))
+
+
+(defun test3 ()
+ (produce-html-string `(html
+ (head
+ (title "Plop"))
+ (body
+ (h1 "A title")
+ (h2 plop)
+ Plop ,(+ 2 2)
+ ,(format nil "Plip=~A" (+ 3 5))
+ |Foo Bar Baz|
+ ("a href=\"index.html\"" Index)
+ (ul
+ (li "toto")
+ (li "klm"))))
+ 10))
+
+
+
+
+
Added: clfswm/netwm-util.lisp
==============================================================================
--- (empty file)
+++ clfswm/netwm-util.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,95 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Wed Feb 20 23:26:21 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: NetWM functions
+;;; http://freedesktop.org/wiki/Specifications_2fwm_2dspec
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+;;; Client List functions
+(defun netwm-set-client-list (id-list)
+ (xlib:change-property *root* :_NET_CLIENT_LIST id-list :window 32))
+
+(defun netwm-get-client-list ()
+ (xlib:get-property *root* :_NET_CLIENT_LIST))
+
+(defun netwm-add-in-client-list (window)
+ (let ((last-list (netwm-get-client-list)))
+ (pushnew (xlib:window-id window) last-list)
+ (netwm-set-client-list last-list)))
+
+(defun netwm-remove-in-client-list (window)
+ (netwm-set-client-list (remove (xlib:window-id window) (netwm-get-client-list))))
+
+
+
+;;; Desktop functions ;; +PHIL
+(defun netwm-update-desktop-property ()
+ ;; (xlib:change-property *root* :_NET_NUMBER_OF_DESKTOPS
+ ;; (list (length *workspace-list*)) :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_DESKTOP_GEOMETRY
+ ;; (list (xlib:screen-width *screen*)
+ ;; (xlib:screen-height *screen*))
+ ;; :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_DESKTOP_VIEWPORT
+ ;; (list 0 0) :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_CURRENT_DESKTOP
+ ;; (list 1) :cardinal 32)
+;;; TODO
+ ;;(xlib:change-property *root* :_NET_DESKTOP_NAMES
+ ;; (list "toto" "klm" "poi") :string 8 :transform #'xlib:char->card8))
+ )
+
+
+
+
+;;; Taken from stumpwm (thanks)
+(defun netwm-set-properties ()
+ "Set NETWM properties on the root window of the specified screen.
+FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
+ ;; _NET_SUPPORTED
+ (xlib:change-property *root* :_NET_SUPPORTED
+ (mapcar (lambda (a)
+ (xlib:intern-atom *display* a))
+ (append +netwm-supported+
+ (mapcar 'car +netwm-window-types+)))
+ :atom 32)
+ ;; _NET_SUPPORTING_WM_CHECK
+ (xlib:change-property *root* :_NET_SUPPORTING_WM_CHECK
+ (list *no-focus-window*) :window 32
+ :transform #'xlib:drawable-id)
+ (xlib:change-property *no-focus-window* :_NET_SUPPORTING_WM_CHECK
+ (list *no-focus-window*) :window 32
+ :transform #'xlib:drawable-id)
+ (xlib:change-property *no-focus-window* :_NET_WM_NAME
+ "clfswm"
+ :string 8 :transform #'xlib:char->card8)
+ (netwm-update-desktop-property))
+
+
+
+
+
Added: clfswm/package.lisp
==============================================================================
--- (empty file)
+++ clfswm/package.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,203 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Mon Feb 25 21:33:22 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Package definition
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :cl-user)
+
+(defpackage clfswm
+ (:use :common-lisp :my-html :tools)
+ ;;(:shadow :defun)
+ (:export :main))
+
+(in-package :clfswm)
+
+
+(defparameter *display* nil)
+(defparameter *screen* nil)
+(defparameter *root* nil)
+(defparameter *no-focus-window* nil)
+(defparameter *root-gc* nil)
+
+(defparameter *default-font* nil)
+;;(defparameter *default-font-string* "9x15")
+(defparameter *default-font-string* "fixed")
+
+
+(defparameter *child-selection* nil)
+
+(defparameter *layout-list* nil)
+
+
+;;(defstruct group (number (incf *current-group-number*)) name
+;; (x 0) (y 0) (w 1) (h 1) rx ry rw rh
+;; layout window gc child)
+
+(defclass group ()
+ ((name :initarg :name :accessor group-name :initform nil)
+ (number :initarg :number :accessor group-number :initform 0)
+ ;;; Float size between 0 and 1 - Manipulate only this variable and not real size
+ (x :initarg :x :accessor group-x :initform 0.1)
+ (y :initarg :y :accessor group-y :initform 0.1)
+ (w :initarg :w :accessor group-w :initform 0.8)
+ (h :initarg :h :accessor group-h :initform 0.8)
+ ;;; Real size (integer) in screen size - Don't set directly this variables
+ ;;; they may be recalculated by the layout manager.
+ (rx :initarg :rx :accessor group-rx :initform 0)
+ (ry :initarg :ry :accessor group-ry :initform 0)
+ (rw :initarg :rw :accessor group-rw :initform 800)
+ (rh :initarg :rh :accessor group-rh :initform 600)
+ (layout :initarg :layout :accessor group-layout :initform nil)
+ (window :initarg :window :accessor group-window :initform nil)
+ (gc :initarg :gc :accessor group-gc :initform nil)
+ (child :initarg :child :accessor group-child :initform nil)
+ (data :initarg :data :accessor group-data
+ :initform (list '(:tile-size 0.8) '(:tile-space-size 0.1))
+ :documentation "An assoc list to store additional data")))
+
+
+
+(defparameter *root-group* nil
+ "Root of the root - ie the root group")
+(defparameter *current-root* nil
+ "The current fullscreen maximized child")
+(defparameter *current-child* nil
+ "The current child with the focus")
+
+(defparameter *show-root-group-p* nil)
+
+
+(defparameter *main-keys* (make-hash-table :test 'equal))
+(defparameter *second-keys* (make-hash-table :test 'equal))
+(defparameter *mouse-action* (make-hash-table :test 'equal))
+(defparameter *pager-keys* (make-hash-table :test 'equal))
+(defparameter *pager-mouse-action* (make-hash-table :test 'equal))
+(defparameter *info-keys* (make-hash-table :test 'equal))
+(defparameter *info-mouse-action* (make-hash-table :test 'equal))
+
+
+(defparameter *open-next-window-in-new-workspace* nil
+ "Set to t to open the next window in a new workspace
+or to a number to open in a numbered workspace")
+
+(defparameter *open-next-window-in-new-group* nil
+ "Set to t to open the each next window in a new group
+or set to :once open the next window in a new group and all
+others in the same group")
+
+(defparameter *arrow-action* nil
+ "Arrow action in the second mode")
+
+(defparameter *pager-arrow-action* nil
+ "Arrow action in the pager mode")
+
+
+
+;;; Hook definitions
+;;;
+;;; A hook is a function, a symbol or a list of functions with a rest
+;;; arguments.
+;;;
+;;; This hooks are set in clfswm.lisp, you can overwrite them or extend
+;;; them with a hook list.
+;;;
+;;; See clfswm.lisp for hooks examples.
+
+;;; Init hook. This hook is run just after the first root group is created
+(defparameter *init-hook* nil)
+
+;;; Main mode hooks (set in clfswm.lisp)
+(defparameter *button-press-hook* nil)
+(defparameter *button-motion-notify-hook* nil)
+(defparameter *key-press-hook* nil)
+(defparameter *configure-request-hook* nil)
+(defparameter *configure-notify-hook* nil)
+(defparameter *create-notify-hook* nil)
+(defparameter *destroy-notify-hook* nil)
+(defparameter *enter-notify-hook* nil)
+(defparameter *exposure-hook* nil)
+(defparameter *map-request-hook* nil)
+(defparameter *mapping-notify-hook* nil)
+(defparameter *property-notify-hook* nil)
+(defparameter *unmap-notify-hook* nil)
+
+
+;;; Second mode hooks (set in clfswm-second-mode.lisp)
+(defparameter *sm-button-press-hook* nil)
+(defparameter *sm-button-release-hook* nil)
+(defparameter *sm-motion-notify-hook* nil)
+(defparameter *sm-key-press-hook* nil)
+(defparameter *sm-configure-request-hook* nil)
+(defparameter *sm-configure-notify-hook* nil)
+(defparameter *sm-map-request-hook* nil)
+(defparameter *sm-unmap-notify-hook* nil)
+(defparameter *sm-destroy-notify-hook* nil)
+(defparameter *sm-mapping-notify-hook* nil)
+(defparameter *sm-property-notify-hook* nil)
+(defparameter *sm-create-notify-hook* nil)
+(defparameter *sm-enter-notify-hook* nil)
+(defparameter *sm-exposure-hook* nil)
+
+
+;;; Pager mode hooks (set in clfswm-pager.lisp)
+(defparameter *pager-button-press-hook* nil)
+(defparameter *pager-button-release-hook* nil)
+(defparameter *pager-motion-notify-hook* nil)
+(defparameter *pager-key-press-hook* nil)
+(defparameter *pager-configure-request-hook* nil)
+(defparameter *pager-map-request-hook* nil)
+(defparameter *pager-unmap-notify-hook* nil)
+(defparameter *pager-destroy-notify-hook* nil)
+(defparameter *pager-mapping-notify-hook* nil)
+(defparameter *pager-property-notify-hook* nil)
+(defparameter *pager-create-notify-hook* nil)
+(defparameter *pager-enter-notify-hook* nil)
+(defparameter *pager-exposure-hook* nil)
+
+
+;;; Second mode global variables
+(defparameter *motion-action* nil)
+(defparameter *motion-object* nil)
+(defparameter *motion-start-group* nil)
+(defparameter *motion-dx* nil)
+(defparameter *motion-dy* nil)
+
+
+;; For debug - redefine defun
+;;(shadow :defun)
+;;
+;;(defmacro defun (name args &body body)
+;; `(progn
+;; (format t "defun: ~A ~A~%" ',name ',args)
+;; (force-output)
+;; (cl:defun ,name ,args
+;; (handler-case
+;; (progn
+;; , at body)
+;; (error (c)
+;; (format t "New defun: Error in ~A : ~A~%" ',name c)
+;; (format t "Root tree=~A~%All windows=~A~%"
+;; (xlib:query-tree *root*) (get-all-windows))
+;; (force-output))))))
Added: clfswm/program
==============================================================================
--- (empty file)
+++ clfswm/program Sat Mar 1 07:49:46 2008
@@ -0,0 +1,26 @@
+
+Show clfswm help (Alt-F1) - Main mode, Second mode and Pager mode
+
+Show group creation on root window and pager usage
+
+Create new window with the shell or the ! clfswm command or apwal
+ (xterm, epiphany, abiword)
+
+Move groups, pack, rezise, fill and same things with the pager
+
+Swap two workspaces, renumber
+
+Show a Gimp usage.
+
+Show xmms and free windows
+
+Copy 3 times the same group and explode group (control+Y) and implode (control+shift+Y)
+
+Show eval application: larswm tile mode (y and Alt+Y)
+ -> enabled when switching groups "tile.lisp"
+
+Show live debugging: *workspace-list*, *screen*, (query-tree *root*),
+ wm-name, config.lisp...
+
+
+And so on . Bye!
\ No newline at end of file
Added: clfswm/sbcl-load.lisp
==============================================================================
--- (empty file)
+++ clfswm/sbcl-load.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,7 @@
+(require :sb-posix)
+(require :clx)
+(require :clfswm)
+
+(in-package :clfswm)
+
+;;(clfswm:main ":1")
Added: clfswm/tools.lisp
==============================================================================
--- (empty file)
+++ clfswm/tools.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,749 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Tue Feb 26 21:53:55 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: General tools
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+
+(in-package :common-lisp-user)
+
+(defpackage tools
+ (:use common-lisp)
+ (:export :it
+ :awhen
+ :aif
+ :dbg
+ :dbgnl
+ :setf/=
+ :create-symbol
+ :split-string
+ :expand-newline
+ :ensure-list
+ :ensure-printable
+ :find-assoc-word
+ :print-space
+ :escape-string
+ :first-position
+ :find-free-number
+ :do-execute
+ :do-shell
+ :getenv
+ :uquit
+ :urun-prog
+ :ushell
+ :ush
+ :ushell-loop
+ :cldebug
+ :get-command-line-words
+ :string-to-list
+ :near-position
+ :string-to-list-multichar
+ :list-to-string
+ :list-to-string-list
+ :clean-string
+ :one-in-list
+ :exchange-one-in-list
+ :rotate-list
+ :anti-rotate-list
+ :append-formated-list
+ :shuffle-list
+ :parse-integer-in-list
+ :convert-to-number
+ :next-in-list :prev-in-list
+ :find-string
+ :find-all-strings
+ :subst-strings
+ :test-find-string))
+
+
+(in-package :tools)
+
+
+(setq *random-state* (make-random-state t))
+
+
+
+(defmacro awhen (test &body body)
+ `(let ((it ,test))
+ (when it
+ , at body)))
+
+(defmacro aif (test then &optional else)
+ `(let ((it ,test)) (if it ,then ,else)))
+
+
+;;;,-----
+;;;| Debuging tools
+;;;`-----
+(defvar *%dbg-name%* "dbg")
+(defvar *%dbg-count%* 0)
+
+
+(defmacro dbg (&rest forms)
+ `(progn
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ (string `(setf *%dbg-name%* ,form))
+ (number `(setf *%dbg-count%* ,form))))
+ forms)
+ (format t "~&DEBUG[~A - ~A] " (incf *%dbg-count%*) *%dbg-name%*)
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ ((or string number) nil)
+ (t `(format t "~A=~S " ',form ,form))))
+ forms)
+ (format t "~%")
+ (force-output)
+ , at forms))
+
+(defmacro dbgnl (&rest forms)
+ `(progn
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ (string `(setf *%dbg-name%* ,form))
+ (number `(setf *%dbg-count%* ,form))))
+ forms)
+ (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ ((or string number) nil)
+ (t `(format t " - ~A=~S~%" ',form ,form))))
+ forms)
+ (force-output)
+ , at forms))
+
+
+
+
+
+
+;;; Tools
+
+
+(defmacro setf/= (var val)
+ "Set var to val only when var not equal to val"
+ (let ((gval (gensym)))
+ `(let ((,gval ,val))
+ (when (/= ,var ,gval)
+ (setf ,var ,gval)))))
+
+
+(defun create-symbol (&rest names)
+ "Return a new symbol from names"
+ (intern (string-upcase (apply #'concatenate 'string names))))
+
+
+(defun split-string (string &optional (separator #\Space))
+ "Return a list from a string splited at each separators"
+ (loop for i = 0 then (1+ j)
+ as j = (position separator string :start i)
+ as sub = (subseq string i j)
+ unless (string= sub "") collect sub
+ while j))
+
+
+(defun expand-newline (list)
+ "Expand all newline in strings in list"
+ (let ((acc nil))
+ (dolist (l list)
+ (setf acc (append acc (split-string l #\Newline))))
+ acc))
+
+(defun ensure-list (object)
+ "Ensure an object is a list"
+ (if (listp object)
+ object
+ (list object)))
+
+
+(defun ensure-printable (string &optional (new #\?))
+ "Ensure a string is printable in ascii"
+ (substitute-if-not new #'standard-char-p string))
+
+
+
+
+(defun find-assoc-word (word line &optional (delim #\"))
+ "Find a word pair"
+ (let* ((pos (search word line))
+ (pos-1 (position delim line :start (or pos 0)))
+ (pos-2 (position delim line :start (1+ (or pos-1 0)))))
+ (when (and pos pos-1 pos-2)
+ (subseq line (1+ pos-1) pos-2))))
+
+
+(defun print-space (n &optional (stream *standard-output*))
+ "Print n spaces on stream"
+ (dotimes (i n)
+ (princ #\Space stream)))
+
+
+(defun escape-string (string &optional (escaper '(#\/ #\: #\) #\( #\Space #\; #\,)) (char #\_))
+ "Replace in string all characters found in the escaper list"
+ (if escaper
+ (escape-string (substitute char (car escaper) string) (cdr escaper) char)
+ string))
+
+
+
+(defun first-position (word string)
+ "Return true only if word is at position 0 in string"
+ (zerop (or (search word string) -1)))
+
+
+(defun find-free-number (l) ; stolen from stumpwm - thanks
+ "Return a number that is not in the list l."
+ (let* ((nums (sort l #'<))
+ (new-num (loop for n from 0 to (or (car (last nums)) 0)
+ for i in nums
+ when (/= n i)
+ do (return n))))
+ (if new-num
+ new-num
+ ;; there was no space between the numbers, so use the last + 1
+ (if (car (last nums))
+ (1+ (car (last nums)))
+ 0))))
+
+
+
+
+
+;;; Shell part (taken from ltk)
+(defun do-execute (program args &optional (wt nil))
+ "execute program with args a list containing the arguments passed to
+the program if wt is non-nil, the function will wait for the execution
+of the program to return.
+ returns a two way stream connected to stdin/stdout of the program"
+ (let ((fullstring program))
+ (dolist (a args)
+ (setf fullstring (concatenate 'string fullstring " " a)))
+ #+:cmu (let ((proc (ext:run-program program args :input :stream
+ :output :stream :wait wt)))
+ (unless proc
+ (error "Cannot create process."))
+ (make-two-way-stream
+ (ext:process-output proc)
+ (ext:process-input proc)))
+ #+:clisp (let ((proc (ext:run-program program :arguments args
+ :input :stream :output
+ :stream :wait (or wt t))))
+ (unless proc
+ (error "Cannot create process."))
+ proc)
+ #+:sbcl (let ((proc (sb-ext:run-program program args :input
+ :stream :output
+ :stream :wait wt)))
+ (unless proc
+ (error "Cannot create process."))
+ (make-two-way-stream
+ (sb-ext:process-output proc)
+ (sb-ext:process-input proc)))
+ #+:lispworks (system:open-pipe fullstring :direction :io)
+ #+:allegro (let ((proc (excl:run-shell-command
+ (apply #'vector program program args)
+ :input :stream :output :stream :wait wt)))
+ (unless proc
+ (error "Cannot create process."))
+ proc)
+ #+:ecl(ext:run-program program args :input :stream :output :stream
+ :error :output)
+ #+:openmcl (let ((proc (ccl:run-program program args :input
+ :stream :output
+ :stream :wait wt)))
+ (unless proc
+ (error "Cannot create process."))
+ (make-two-way-stream
+ (ccl:external-process-output-stream proc)
+ (ccl:external-process-input-stream proc)))))
+
+(defun do-shell (program &optional args (wt nil))
+ (do-execute "/bin/sh" `("-c" ,program , at args) wt))
+
+
+
+
+
+
+
+(defun getenv (var)
+ "Return the value of the environment variable."
+ #+allegro (sys::getenv (string var))
+ #+clisp (ext:getenv (string var))
+ #+(or cmu scl)
+ (cdr (assoc (string var) ext:*environment-list* :test #'equalp
+ :key #'string))
+ #+gcl (si:getenv (string var))
+ #+lispworks (lw:environment-variable (string var))
+ #+lucid (lcl:environment-variable (string var))
+ #+mcl (ccl::getenv var)
+ #+sbcl (sb-posix:getenv (string var))
+ #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl)
+ (error 'not-implemented :proc (list 'getenv var)))
+
+
+(defun (setf getenv) (val var)
+ "Set an environment variable."
+ #+allegro (setf (sys::getenv (string var)) (string val))
+ #+clisp (setf (ext:getenv (string var)) (string val))
+ #+(or cmu scl)
+ (let ((cell (assoc (string var) ext:*environment-list* :test #'equalp
+ :key #'string)))
+ (if cell
+ (setf (cdr cell) (string val))
+ (push (cons (intern (string var) "KEYWORD") (string val))
+ ext:*environment-list*)))
+ #+gcl (si:setenv (string var) (string val))
+ #+lispworks (setf (lw:environment-variable (string var)) (string val))
+ #+lucid (setf (lcl:environment-variable (string var)) (string val))
+ #+sbcl (sb-posix:putenv (format nil "~A=~A" (string var) (string val)))
+ #-(or allegro clisp cmu gcl lispworks lucid sbcl scl)
+ (error 'not-implemented :proc (list '(setf getenv) var)))
+
+
+
+
+
+
+
+(defun uquit ()
+ #+(or clisp cmu) (ext:quit)
+ #+sbcl (sb-ext:quit)
+ #+ecl (si:quit)
+ #+gcl (lisp:quit)
+ #+lispworks (lw:quit)
+ #+(or allegro-cl allegro-cl-trial) (excl:exit))
+
+
+
+
+(defun remove-plist (plist &rest keys)
+ "Remove the keys from the plist.
+Useful for re-using the &REST arg after removing some options."
+ (do (copy rest)
+ ((null (setq rest (nth-value 2 (get-properties plist keys))))
+ (nreconc copy plist))
+ (do () ((eq plist rest))
+ (push (pop plist) copy)
+ (push (pop plist) copy))
+ (setq plist (cddr plist))))
+
+
+
+
+(defun urun-prog (prog &rest opts &key args (wait t) &allow-other-keys)
+ "Common interface to shell. Does not return anything useful."
+ #+gcl (declare (ignore wait))
+ (setq opts (remove-plist opts :args :wait))
+ #+allegro (apply #'excl:run-shell-command (apply #'vector prog prog args)
+ :wait wait opts)
+ #+(and clisp lisp=cl)
+ (apply #'ext:run-program prog :arguments args :wait wait opts)
+ #+(and clisp (not lisp=cl))
+ (if wait
+ (apply #'lisp:run-program prog :arguments args opts)
+ (lisp:shell (format nil "~a~{ '~a'~} &" prog args)))
+ #+cmu (apply #'ext:run-program prog args :wait wait :output *standard-output* opts)
+ #+gcl (apply #'si:run-process prog args)
+ #+liquid (apply #'lcl:run-program prog args)
+ #+lispworks (apply #'sys::call-system-showing-output
+ (format nil "~a~{ '~a'~}~@[ &~]" prog args (not wait))
+ opts)
+ #+lucid (apply #'lcl:run-program prog :wait wait :arguments args opts)
+ #+sbcl (apply #'sb-ext:run-program prog args :wait wait :output *standard-output* opts)
+ #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl)
+ (error 'not-implemented :proc (list 'run-prog prog opts)))
+
+
+;;(defparameter *shell-cmd* "/usr/bin/env")
+;;(defparameter *shell-cmd-opt* nil)
+
+#+UNIX (defparameter *shell-cmd* "/bin/sh")
+#+UNIX (defparameter *shell-cmd-opt* '("-c"))
+
+#+WIN32 (defparameter *shell-cmd* "cmd.exe")
+#+WIN32 (defparameter *shell-cmd-opt* '("/C"))
+
+
+(defun ushell (&rest strings)
+ (urun-prog *shell-cmd* :args (append *shell-cmd-opt* strings)))
+
+(defun ush (string)
+ (urun-prog *shell-cmd* :args (append *shell-cmd-opt* (list string))))
+
+
+(defun set-shell-dispatch (&optional (shell-fun 'ushell))
+ (labels ((|shell-reader| (stream subchar arg)
+ (declare (ignore subchar arg))
+ (list shell-fun (read stream t nil t))))
+ (set-dispatch-macro-character #\# #\# #'|shell-reader|)))
+
+
+(defun ushell-loop (&optional (shell-fun #'ushell))
+ (loop
+ (format t "UNI-SHELL> ")
+ (let* ((line (read-line)))
+ (cond ((zerop (or (search "quit" line) -1)) (return))
+ ((zerop (or (position #\! line) -1))
+ (funcall shell-fun (subseq line 1)))
+ (t (format t "~{~A~^ ;~%~}~%"
+ (multiple-value-list
+ (ignore-errors (eval (read-from-string line))))))))))
+
+
+
+
+
+
+(defun cldebug (&rest rest)
+ (princ "DEBUG: ")
+ (dolist (i rest)
+ (princ i))
+ (terpri))
+
+
+(defun get-command-line-words ()
+ #+CLISP ext:*args*
+ #+CMU (nthcdr 3 extensions:*command-line-strings*)
+ #+SBCL sb-ext:*posix-argv*)
+
+
+
+(defun string-to-list (str &key (split-char #\space))
+ (do* ((start 0 (1+ index))
+ (index (position split-char str :start start)
+ (position split-char str :start start))
+ (accum nil))
+ ((null index)
+ (unless (string= (subseq str start) "")
+ (push (subseq str start) accum))
+ (nreverse accum))
+ (when (/= start index)
+ (push (subseq str start index) accum))))
+
+
+(defun near-position (chars str &key (start 0))
+ (do* ((char chars (cdr char))
+ (pos (position (car char) str :start start)
+ (position (car char) str :start start))
+ (ret (when pos pos)
+ (if pos
+ (if ret
+ (if (< pos ret)
+ pos
+ ret)
+ pos)
+ ret)))
+ ((null char) ret)))
+
+
+;;;(defun near-position2 (chars str &key (start 0))
+;;; (loop for i in chars
+;;; minimize (position i str :start start)))
+
+;;(format t "~S~%" (near-position '(#\! #\. #\Space #\;) "klmsqk ppii;dsdsqkl.jldfksj lkm" :start 0))
+;;(format t "~S~%" (near-position '(#\Space) "klmsqk ppii;dsdsqkl.jldfksj lkm" :start 0))
+;;(format t "~S~%" (near-position '(#\; #\l #\m) "klmsqk ppii;dsdsqkl.jldfksj lkm" :start 0))
+;;(format t "result=~S~%" (string-to-list-multichar "klmsqk ppii;dsdsqkl.jldfksj lkm" :preserve t))
+;;(format t "result=~S~%" (string-to-list-multichar "klmsqk ppii;dsd!sqkl.jldfksj lkm"
+;; :split-chars '(#\k #\! #\. #\; #\m)
+;; :preserve nil))
+
+
+(defun string-to-list-multichar (str &key (split-chars '(#\space)) (preserve nil))
+ (do* ((start 0 (1+ index))
+ (index (near-position split-chars str :start start)
+ (near-position split-chars str :start start))
+ (accum nil))
+ ((null index)
+ (unless (string= (subseq str start) "")
+ (push (subseq str start) accum))
+ (nreverse accum))
+ (let ((retstr (subseq str start (if preserve (1+ index) index))))
+ (unless (string= retstr "")
+ (push retstr accum)))))
+
+
+
+
+
+(defun list-to-string (lst)
+ (string-trim " () " (format nil "~A" lst)))
+
+
+
+(defun clean-string (string)
+ "Remove Newline and upcase string"
+ (string-upcase
+ (string-right-trim '(#\Newline) string)))
+
+(defun one-in-list (lst)
+ (nth (random (length lst)) lst))
+
+(defun exchange-one-in-list (lst1 lst2)
+ (let ((elem1 (one-in-list lst1))
+ (elem2 (one-in-list lst2)))
+ (setf lst1 (append (remove elem1 lst1) (list elem2)))
+ (setf lst2 (append (remove elem2 lst2) (list elem1)))
+ (values lst1 lst2)))
+
+
+(defun rotate-list (list)
+ (when list
+ (append (cdr list) (list (car list)))))
+
+(defun anti-rotate-list (list)
+ (when list
+ (append (last list) (butlast list))))
+
+
+(defun append-formated-list (base-str
+ lst
+ &key (test-not-fun #'(lambda (x) x nil))
+ (print-fun #'(lambda (x) x))
+ (default-str ""))
+ (let ((str base-str) (first t))
+ (dolist (i lst)
+ (cond ((funcall test-not-fun i) nil)
+ (t (setq str
+ (concatenate 'string str
+ (if first "" ", ")
+ (format nil "~A"
+ (funcall print-fun i))))
+ (setq first nil))))
+ (if (string= base-str str)
+ (concatenate 'string str default-str) str)))
+
+
+(defun shuffle-list (list &key (time 1))
+ "Shuffle a list by swapping elements time times"
+ (let ((result (copy-list list))
+ (ind1 0) (ind2 0) (swap 0))
+ (dotimes (i time)
+ (setf ind1 (random (length result)))
+ (setf ind2 (random (length result)))
+
+ (setf swap (nth ind1 result))
+ (setf (nth ind1 result) (nth ind2 result))
+ (setf (nth ind2 result) swap))
+ result))
+
+
+
+(defun convert-to-number (str)
+ (cond ((stringp str) (parse-integer str :junk-allowed t))
+ ((numberp str) str)))
+
+(defun parse-integer-in-list (lst)
+ "Convert all integer string in lst to integer"
+ (mapcar #'(lambda (x) (convert-to-number x)) lst))
+
+
+
+(defun next-in-list (item lst)
+ (do ((x lst (cdr x)))
+ ((null x))
+ (when (equal item (car x))
+ (return (if (cadr x) (cadr x) (car lst))))))
+
+(defun prev-in-list (item lst)
+ (next-in-list item (reverse lst)))
+
+
+;;(defun transfert-stream (in out length &key (bufsize 4096))
+;;;; (ignore-errors
+;; (do* ((data (make-array bufsize
+;; :element-type (stream-element-type in)))
+;; (len 0 (read-sequence data in
+;; :start 0
+;; :end (if (> (+ wlen bufsize) length)
+;; (- length wlen)
+;; bufsize)))
+;; (wlen 0 (+ wlen len)))
+;; ((>= wlen length) (write-sequence data out :start 0 :end len))
+;; (write-sequence data out :start 0 :end len)));)
+;;
+;;
+;;
+;;
+;;
+;;(defun my-copy-file (in-name out-name)
+;; (with-open-file
+;; (in in-name :direction :input :element-type '(unsigned-byte 8))
+;; (with-open-file
+;; (out out-name :direction :output
+;; :if-exists :supersede
+;; :element-type '(unsigned-byte 8))
+;; (transfert-stream in out (file-length in)))))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;
+;; Find String part. ;;
+;; ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun find-string (substr str &key (start 0) (end nil)
+ (test nil) (ignore-case nil))
+ "Find substr in str. Return begin and end of substr in str as two values.
+Start and end set the findinq region. Ignore-case make find-string case
+insensitive.
+Test (if needed) must be a function which take str pos1 pos2 and must return
+new positions of the substr in str as two values"
+ (when (and end (>= start end))
+ (return-from find-string nil))
+ (let ((pos1 (- start 1))
+ (pos2 nil)
+ (len (length substr)))
+ (when ignore-case
+ (setq str (string-upcase str)
+ substr (string-upcase substr)))
+ (do ((done nil))
+ (done (if (functionp test)
+ (funcall test str pos1 pos2)
+ (values pos1 pos2)))
+ (setq pos1 (position (aref substr 0) str :start (+ pos1 1) :end end))
+ (unless pos1
+ (return-from find-string nil))
+ (setq pos2 (string>= str substr :start1 pos1 :end1 end))
+ (when (and pos2 (= (- pos2 pos1) len))
+ (setq done t)))))
+
+
+
+(defun find-all-strings (substr str &key (start 0) (end nil)
+ (test nil) (ignore-case nil))
+ "Find all substr in str. Parameters are the same as find-string.
+Return a list with all begin and end positions of substr in str
+ie: '((pos1.1 pos1.2) (pos2.1 pos2.2))..."
+ (do ((pos (multiple-value-list
+ (find-string substr str :start start :end end
+ :test test :ignore-case ignore-case))
+ (multiple-value-list
+ (find-string substr str :start (second pos) :end end
+ :test test :ignore-case ignore-case)))
+ (accum nil))
+ ((equal pos '(nil)) (nreverse accum))
+ (push pos accum)))
+
+
+
+(defun subst-strings (new substr str &key (start 0) (end nil)
+ (test nil) (ignore-case nil))
+ "Substitute all substr strings in str with new.
+New must be a string or a function witch takes str pos1 pos2
+as parameters and return a string to replace substr"
+ (let ((outstr (subseq str 0 start))
+ (pos1 start)
+ (pos2 0)
+ (newpos 0))
+ (unless end
+ (setq end (length str)))
+ (do ((done nil))
+ (done outstr)
+ (multiple-value-setq
+ (pos2 newpos)
+ (find-string substr str :start pos1 :end end
+ :test test :ignore-case ignore-case))
+ (if pos2
+ (progn
+ (setq outstr (concatenate 'string
+ outstr
+ (subseq str pos1 pos2)
+ (if (functionp new)
+ (funcall new str pos2 newpos)
+ new)))
+ (setq pos1 (if (and newpos (<= newpos end))
+ newpos
+ end)))
+ (progn
+ (setq outstr (concatenate 'string
+ outstr (subseq str pos1)))
+ (setq done t))))))
+
+
+
+(defun my-find-string-test (str pos1 pos2)
+ (multiple-value-bind
+ (npos1 npos2)
+ (find-string "=>" str :start pos2)
+ (declare (ignore npos1))
+ (values pos1 npos2)))
+
+
+(defun test-find-string ()
+ (let ((count 0)
+ (str "bla bla foo <= plop gloup => foo
+baz bar <=klm poi => boo <=plop=> faz
+lab totrs <= plip =>"))
+
+ (format t "Original:~%~A~2%" str)
+ (format t "[1] Simple find on '<=': ~A~%"
+ (multiple-value-list
+ (find-string "<=" str)))
+ (format t "[2] Find with start=15/end=50: ~A~%"
+ (multiple-value-list
+ (find-string "<=" str :start 15 :end 50)))
+
+ (format t "[3] Find with test (ie '<=.*=>'): ~A~%"
+ (multiple-value-bind
+ (pos1 pos2)
+ (find-string "<=" str :test #'my-find-string-test)
+ (subseq str pos1 pos2)))
+
+ (format t "[4] Find all strings: ~A~%"
+ (find-all-strings "<=" str))
+
+ (format t "[5] Find all strings:~%")
+ (dolist (pos (find-all-strings "<=" str))
+ (format t "Found: ~A~%"
+ (subseq str (car pos) (second pos))))
+
+ (format t "[6] Find all strings with test:~%")
+ (dolist (pos (find-all-strings "<=" str :test #'my-find-string-test))
+ (format t "Found: ~A~%" (subseq str (car pos) (second pos))))
+
+ (format t "[7] Modifie '<=.*=>' with TOTO:~%~A"
+ (subst-strings "TOTO" "<=" str
+ :test #'my-find-string-test))
+ (format t "~%")
+ (format t "[8] Modifie '<=.*=>' with a complex expression:~%~A~%"
+ (subst-strings
+ #'(lambda (str pos1 pos2)
+ (let ((repl (string-trim " "
+ (subseq str (+ pos1 2) (- pos2 2)))))
+ (format nil "<=~A:~A (~A)=>"
+ (incf count)
+ repl
+ (reverse repl))))
+ "<=" str
+ :test #'(lambda (str pos1 pos2)
+ (multiple-value-bind
+ (npos1 npos2)
+ (find-string "=>" str :start pos2)
+ (declare (ignore npos1))
+ (values pos1 npos2)))))))
+
+
Added: clfswm/xlib-util.lisp
==============================================================================
--- (empty file)
+++ clfswm/xlib-util.lisp Sat Mar 1 07:49:46 2008
@@ -0,0 +1,491 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; #Date#: Thu Feb 28 21:55:00 2008
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Utility functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+;; Window states
+(defconstant +withdrawn-state+ 0)
+(defconstant +normal-state+ 1)
+(defconstant +iconic-state+ 3)
+
+
+(defparameter *window-events* '(:structure-notify
+ :property-change
+ :colormap-change
+ :focus-change
+ :enter-window
+ :exposure)
+ ;;:button-press
+ ;;:button-release)
+ "The events to listen for on managed windows.")
+
+
+(defparameter +netwm-supported+
+ '(:_NET_SUPPORTING_WM_CHECK
+ :_NET_NUMBER_OF_DESKTOPS
+ :_NET_DESKTOP_GEOMETRY
+ :_NET_DESKTOP_VIEWPORT
+ :_NET_CURRENT_DESKTOP
+ :_NET_WM_WINDOW_TYPE
+ :_NET_CLIENT_LIST)
+ "Supported NETWM properties.
+Window types are in +WINDOW-TYPES+.")
+
+(defparameter +netwm-window-types+
+ '((:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop)
+ (:_NET_WM_WINDOW_TYPE_DOCK . :dock)
+ (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar)
+ (:_NET_WM_WINDOW_TYPE_MENU . :menu)
+ (:_NET_WM_WINDOW_TYPE_UTILITY . :utility)
+ (:_NET_WM_WINDOW_TYPE_SPLASH . :splash)
+ (:_NET_WM_WINDOW_TYPE_DIALOG . :dialog)
+ (:_NET_WM_WINDOW_TYPE_NORMAL . :normal))
+ "Alist mapping NETWM window types to keywords.")
+
+
+(defmacro with-xlib-protect (&body body)
+ "Prevent Xlib errors"
+ `(handler-case
+ (progn
+ , at body)
+ ((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
+ (declare (ignore c)))))
+
+
+
+(defun parse-display-string (display)
+ "Parse an X11 DISPLAY string and return the host and display from it."
+ (let* ((colon (position #\: display))
+ (host (subseq display 0 colon))
+ (rest (subseq display (1+ colon)))
+ (dot (position #\. rest))
+ (num (parse-integer (subseq rest 0 dot))))
+ (values host num)))
+
+
+(defun banish-pointer ()
+ "Move the pointer to the lower right corner of the screen"
+ (xlib:warp-pointer *root*
+ (1- (xlib:screen-width *screen*))
+ (1- (xlib:screen-height *screen*))))
+
+
+
+
+
+(defun window-state (win)
+ "Get the state (iconic, normal, withdraw of a window."
+ (first (xlib:get-property win :WM_STATE)))
+
+
+(defun set-window-state (win state)
+ "Set the state (iconic, normal, withdrawn) of a window."
+ (xlib:change-property win
+ :WM_STATE
+ (list state)
+ :WM_STATE
+ 32))
+
+(defsetf window-state set-window-state)
+
+
+
+(defun window-hidden-p (window)
+ (eql (window-state window) +iconic-state+))
+
+
+
+(defun unhide-window (window)
+ (when window
+ (with-xlib-protect
+ (xlib:map-window window)
+ (setf (window-state window) +normal-state+
+ (xlib:window-event-mask window) *window-events*))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;(defconstant +exwm-atoms+
+;; (list "_NET_SUPPORTED" "_NET_CLIENT_LIST"
+;; "_NET_CLIENT_LIST_STACKING" "_NET_NUMBER_OF_DESKTOPS"
+;; "_NET_CURRENT_DESKTOP" "_NET_DESKTOP_GEOMETRY"
+;; "_NET_DESKTOP_VIEWPORT" "_NET_DESKTOP_NAMES"
+;; "_NET_ACTIVE_WINDOW" "_NET_WORKAREA"
+;; "_NET_SUPPORTING_WM_CHECK" "_NET_VIRTUAL_ROOTS"
+;; "_NET_DESKTOP_LAYOUT"
+;;
+;; "_NET_RESTACK_WINDOW" "_NET_REQUEST_FRAME_EXTENTS"
+;; "_NET_MOVERESIZE_WINDOW" "_NET_CLOSE_WINDOW"
+;; "_NET_WM_MOVERESIZE"
+;;
+;; "_NET_WM_SYNC_REQUEST" "_NET_WM_PING"
+;;
+;; "_NET_WM_NAME" "_NET_WM_VISIBLE_NAME"
+;; "_NET_WM_ICON_NAME" "_NET_WM_VISIBLE_ICON_NAME"
+;; "_NET_WM_DESKTOP" "_NET_WM_WINDOW_TYPE"
+;; "_NET_WM_STATE" "_NET_WM_STRUT"
+;; "_NET_WM_ICON_GEOMETRY" "_NET_WM_ICON"
+;; "_NET_WM_PID" "_NET_WM_HANDLED_ICONS"
+;; "_NET_WM_USER_TIME" "_NET_FRAME_EXTENTS"
+;; ;; "_NET_WM_MOVE_ACTIONS"
+;;
+;; "_NET_WM_WINDOW_TYPE_DESKTOP" "_NET_WM_STATE_MODAL"
+;; "_NET_WM_WINDOW_TYPE_DOCK" "_NET_WM_STATE_STICKY"
+;; "_NET_WM_WINDOW_TYPE_TOOLBAR" "_NET_WM_STATE_MAXIMIZED_VERT"
+;; "_NET_WM_WINDOW_TYPE_MENU" "_NET_WM_STATE_MAXIMIZED_HORZ"
+;; "_NET_WM_WINDOW_TYPE_UTILITY" "_NET_WM_STATE_SHADED"
+;; "_NET_WM_WINDOW_TYPE_SPLASH" "_NET_WM_STATE_SKIP_TASKBAR"
+;; "_NET_WM_WINDOW_TYPE_DIALOG" "_NET_WM_STATE_SKIP_PAGER"
+;; "_NET_WM_WINDOW_TYPE_NORMAL" "_NET_WM_STATE_HIDDEN"
+;; "_NET_WM_STATE_FULLSCREEN"
+;; "_NET_WM_STATE_ABOVE"
+;; "_NET_WM_STATE_BELOW"
+;; "_NET_WM_STATE_DEMANDS_ATTENTION"
+;;
+;; "_NET_WM_ALLOWED_ACTIONS"
+;; "_NET_WM_ACTION_MOVE"
+;; "_NET_WM_ACTION_RESIZE"
+;; "_NET_WM_ACTION_SHADE"
+;; "_NET_WM_ACTION_STICK"
+;; "_NET_WM_ACTION_MAXIMIZE_HORZ"
+;; "_NET_WM_ACTION_MAXIMIZE_VERT"
+;; "_NET_WM_ACTION_FULLSCREEN"
+;; "_NET_WM_ACTION_CHANGE_DESKTOP"
+;; "_NET_WM_ACTION_CLOSE"
+;;
+;; ))
+;;
+;;
+;;(defun intern-atoms (display)
+;; (declare (type xlib:display display))
+;; (mapcar #'(lambda (atom-name) (xlib:intern-atom display atom-name))
+;; +exwm-atoms+)
+;; (values))
+;;
+;;
+;;
+;;(defun get-atoms-property (window property-atom atom-list-p)
+;; "Returns a list of atom-name (if atom-list-p is t) otherwise returns
+;; a list of atom-id."
+;; (xlib:get-property window property-atom
+;; :transform (when atom-list-p
+;; (lambda (id)
+;; (xlib:atom-name (xlib:drawable-display window) id)))))
+;;
+;;(defun set-atoms-property (window atoms property-atom &key (mode :replace))
+;; "Sets the property designates by `property-atom'. ATOMS is a list of atom-id
+;; or a list of keyword atom-names."
+;; (xlib:change-property window property-atom atoms :ATOM 32
+;; :mode mode
+;; :transform (unless (integerp (car atoms))
+;; (lambda (atom-key)
+;; (xlib:find-atom (xlib:drawable-display window) atom-key)))))
+;;
+;;
+;;
+;;
+;;(defun net-wm-state (window)
+;; (get-atoms-property window :_NET_WM_STATE t))
+;;
+;;(defsetf net-wm-state (window &key (mode :replace)) (states)
+;; `(set-atoms-property ,window ,states :_NET_WM_STATE :mode ,mode))
+;;
+;;
+;;
+;;(defun hide-window (window)
+;; (when window
+;; (with-xlib-protect
+;; (let ((net-wm-state (net-wm-state window)))
+;; (dbg net-wm-state)
+;; (pushnew :_net_wm_state_hidden net-wm-state)
+;; (setf (net-wm-state window) net-wm-state)
+;; (dbg (net-wm-state window)))
+;; (setf (window-state window) +iconic-state+
+;; (xlib:window-event-mask window) (remove :structure-notify *window-events*))
+;; (xlib:unmap-window window)
+;; (setf (xlib:window-event-mask window) *window-events*))))
+
+
+(defun hide-window (window)
+ (when window
+ (with-xlib-protect
+ (setf (window-state window) +iconic-state+
+ (xlib:window-event-mask window) (remove :structure-notify *window-events*))
+ (xlib:unmap-window window)
+ (setf (xlib:window-event-mask window) *window-events*))))
+
+
+
+(defun window-type (window)
+ "Return one of :desktop, :dock, :toolbar, :utility, :splash,
+:dialog, :transient, :maxsize and :normal."
+ (or (and (let ((hints (xlib:wm-normal-hints window)))
+ (and hints (or (xlib:wm-size-hints-max-width hints)
+ (xlib:wm-size-hints-max-height hints)
+ (xlib:wm-size-hints-min-aspect hints)
+ (xlib:wm-size-hints-max-aspect hints))))
+ :maxsize)
+ (let ((net-wm-window-type (xlib:get-property window :_NET_WM_WINDOW_TYPE)))
+ (when net-wm-window-type
+ (dolist (type-atom net-wm-window-type)
+ (when (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)
+ (return (cdr (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)))))))
+ (and (xlib:get-property window :WM_TRANSIENT_FOR)
+ :transient)
+ :normal))
+
+
+
+
+
+;; Stolen from Eclipse
+(defun send-configuration-notify (window)
+ "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
+ (multiple-value-bind (x y)
+ (xlib:translate-coordinates window 0 0 (xlib:drawable-root window))
+ (xlib:send-event window
+ :configure-notify
+ (xlib:make-event-mask :structure-notify)
+ :event-window window :window window
+ :x x :y y
+ :override-redirect-p nil
+ :border-width (xlib:drawable-border-width window)
+ :width (xlib:drawable-width window)
+ :height (xlib:drawable-height window)
+ :propagate-p nil)))
+
+
+(defun send-client-message (window type &rest data)
+ "Send a client message to a client's window."
+ (xlib:send-event window
+ :client-message nil
+ :window window
+ :type type
+ :format 32
+ :data data))
+
+
+
+
+
+(defun raise-window (window)
+ "Map the window if needed and bring it to the top of the stack. Does not affect focus."
+ (when window
+ (with-xlib-protect
+ (when (window-hidden-p window)
+ (unhide-window window))
+ (setf (xlib:window-priority window) :top-if))))
+
+(defun focus-window (window)
+ "Give the window focus."
+ (when window
+ (with-xlib-protect
+ (raise-window window)
+ (xlib:set-input-focus *display* window :parent))))
+ ;;(xlib:set-input-focus *display* :pointer-root :pointer-root)) ;;PHIL
+
+
+
+
+
+
+(defun no-focus ()
+ "don't focus any window but still read keyboard events."
+ (xlib:set-input-focus *display* *no-focus-window* :pointer-root))
+
+
+
+
+(let ((cursor-font nil)
+ (cursor nil)
+ (pointer-grabbed nil))
+ (labels ((free-grab-pointer ()
+ (when cursor
+ (xlib:free-cursor cursor)
+ (setf cursor nil))
+ (when cursor-font
+ (xlib:close-font cursor-font)
+ (setf cursor-font nil))))
+ (defun xgrab-init-pointer ()
+ (setf pointer-grabbed nil))
+
+ (defun xgrab-pointer-p ()
+ pointer-grabbed)
+
+ (defun xgrab-pointer (root cursor-char cursor-mask-char
+ &optional (pointer-mask '(:enter-window :pointer-motion
+ :button-press :button-release)) owner-p)
+ "Grab the pointer and set the pointer shape."
+ (free-grab-pointer)
+ (setf pointer-grabbed t)
+ (let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
+ (black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)))
+ (setf cursor-font (xlib:open-font *display* "cursor")
+ cursor (xlib:create-glyph-cursor :source-font cursor-font
+ :source-char cursor-char
+ :mask-font cursor-font
+ :mask-char cursor-mask-char
+ :foreground black
+ :background white))
+ (xlib:grab-pointer root pointer-mask
+ :owner-p owner-p :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
+
+ (defun xungrab-pointer ()
+ "Remove the grab on the cursor and restore the cursor shape."
+ (setf pointer-grabbed nil)
+ (xlib:ungrab-pointer *display*)
+ (free-grab-pointer))))
+
+
+(let ((keyboard-grabbed nil))
+ (defun xgrab-init-keyboard ()
+ (setf keyboard-grabbed nil))
+
+ (defun xgrab-keyboard-p ()
+ keyboard-grabbed)
+
+ (defun xgrab-keyboard (root)
+ (setf keyboard-grabbed t)
+ (xlib:grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
+
+ (defun xungrab-keyboard ()
+ (setf keyboard-grabbed nil)
+ (xlib:ungrab-keyboard *display*)))
+
+
+
+
+(defun stop-button-event ()
+ (xlib:allow-events *display* :sync-pointer))
+
+(defun replay-button-event ()
+ (xlib:allow-events *display* :replay-pointer))
+
+
+(defun ungrab-all-buttons (window)
+ (xlib:ungrab-button window :any :modifiers :any))
+
+(defun grab-all-buttons (window)
+ (ungrab-all-buttons window)
+ (xlib:grab-button window :any '(:button-press)
+ :modifiers :any
+ :owner-p nil
+ :sync-pointer-p t
+ :sync-keyboard-p nil))
+
+
+
+(defun get-color (color)
+ (xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
+
+
+
+
+(defun my-character->keysyms (ch)
+ "Convert a char to a keysym"
+ ;; XLIB:CHARACTER->KEYSYMS should probably be implemented in NEW-CLX
+ ;; some day. Or just copied from MIT-CLX or some other CLX
+ ;; implementation (see translate.lisp and keysyms.lisp). For now,
+ ;; we do like this. It suffices for modifiers and ASCII symbols.
+ (if (fboundp 'xlib:character->keysyms)
+ (xlib:character->keysyms ch))
+ (list
+ (case ch
+ (:character-set-switch #xFF7E)
+ (:left-shift #xFFE1)
+ (:right-shift #xFFE2)
+ (:left-control #xFFE3)
+ (:right-control #xFFE4)
+ (:caps-lock #xFFE5)
+ (:shift-lock #xFFE6)
+ (:left-meta #xFFE7)
+ (:right-meta #xFFE8)
+ (:left-alt #xFFE9)
+ (:right-alt #xFFEA)
+ (:left-super #xFFEB)
+ (:right-super #xFFEC)
+ (:left-hyper #xFFED)
+ (:right-hyper #xFFEE)
+ (t
+ (etypecase ch
+ (character
+ ;; Latin-1 characters have their own value as keysym
+ (if (< 31 (char-code ch) 256)
+ (char-code ch)
+ (error "Don't know how to get keysym from ~A" ch))))))))
+
+
+
+(defun char->keycode (char)
+ "Convert a character to a keycode"
+ (xlib:keysym->keycodes *display* (first (my-character->keysyms char))))
+
+
+(defun keycode->char (code state)
+ (xlib:keysym->character *display* (xlib:keycode->keysym *display* code 0) state))
+
+(defun modifiers->state (modifier-list)
+ (apply #'xlib:make-state-mask modifier-list))
+
+(defun state->modifiers (state)
+ (xlib:make-state-keys state))
+
+
+
+
+(defun wait-no-key-or-button-press ()
+ (loop
+ (let ((key (loop for k across (xlib:query-keymap *display*)
+ unless (zerop k) return t))
+ (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
+ (when (and (not key) (not button))
+ (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
+ (:motion-notify () t)
+ (:key-press () t)
+ (:button-press () t)
+ (:button-release () t)
+ (t nil)))
+ (return-from wait-no-key-or-button-press nil)))))
+
+
+
+(defun compress-motion-notify ()
+ (when *have-to-compress-notify*
+ (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
+ (:motion-notify () t))))
+
More information about the clfswm-cvs
mailing list