diff options
Diffstat (limited to 'third_party/exwm')
| -rw-r--r-- | third_party/exwm/.elpaignore | 2 | ||||
| -rw-r--r-- | third_party/exwm/.gitignore | 3 | ||||
| -rw-r--r-- | third_party/exwm/LICENSE | 674 | ||||
| -rw-r--r-- | third_party/exwm/README.md | 21 | ||||
| -rw-r--r-- | third_party/exwm/default.nix | 14 | ||||
| -rw-r--r-- | third_party/exwm/exwm-background.el | 199 | ||||
| -rw-r--r-- | third_party/exwm/exwm-config.el | 131 | ||||
| -rw-r--r-- | third_party/exwm/exwm-core.el | 411 | ||||
| -rw-r--r-- | third_party/exwm/exwm-floating.el | 780 | ||||
| -rw-r--r-- | third_party/exwm/exwm-input.el | 1248 | ||||
| -rw-r--r-- | third_party/exwm/exwm-layout.el | 631 | ||||
| -rw-r--r-- | third_party/exwm/exwm-manage.el | 833 | ||||
| -rw-r--r-- | third_party/exwm/exwm-randr.el | 369 | ||||
| -rw-r--r-- | third_party/exwm/exwm-systemtray.el | 701 | ||||
| -rw-r--r-- | third_party/exwm/exwm-workspace.el | 1768 | ||||
| -rw-r--r-- | third_party/exwm/exwm-xim.el | 810 | ||||
| -rw-r--r-- | third_party/exwm/exwm-xsettings.el | 336 | ||||
| -rw-r--r-- | third_party/exwm/exwm.el | 1113 | ||||
| -rw-r--r-- | third_party/exwm/xinitrc | 20 |
19 files changed, 10064 insertions, 0 deletions
diff --git a/third_party/exwm/.elpaignore b/third_party/exwm/.elpaignore new file mode 100644 index 000000000000..f0f644ee08ad --- /dev/null +++ b/third_party/exwm/.elpaignore @@ -0,0 +1,2 @@ +LICENSE +README.md diff --git a/third_party/exwm/.gitignore b/third_party/exwm/.gitignore new file mode 100644 index 000000000000..9e4b0ee5b48e --- /dev/null +++ b/third_party/exwm/.gitignore @@ -0,0 +1,3 @@ +*.elc +*-pkg.el +*-autoloads.el diff --git a/third_party/exwm/LICENSE b/third_party/exwm/LICENSE new file mode 100644 index 000000000000..9cecc1d4669e --- /dev/null +++ b/third_party/exwm/LICENSE @@ -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: + + {project} Copyright (C) {year} {fullname} + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/third_party/exwm/README.md b/third_party/exwm/README.md new file mode 100644 index 000000000000..6d7e0dd1ff17 --- /dev/null +++ b/third_party/exwm/README.md @@ -0,0 +1,21 @@ +# Emacs X Window Manager + +EXWM (Emacs X Window Manager) is a full-featured tiling X window manager +for Emacs built on top of [XELB](https://github.com/ch11ng/xelb). +It features: ++ Fully keyboard-driven operations ++ Hybrid layout modes (tiling & stacking) ++ Dynamic workspace support ++ ICCCM/EWMH compliance ++ (Optional) RandR (multi-monitor) support ++ (Optional) Builtin system tray ++ (Optional) Builtin input method + +Please check out the +[screenshots](https://github.com/ch11ng/exwm/wiki/Screenshots) +to get an overview of what EXWM is capable of, +and the [user guide](https://github.com/ch11ng/exwm/wiki) +for a detailed explanation of its usage. + +**Note**: If you install EXWM from source, it's recommended to install +XELB also from source (otherwise install both from GNU ELPA). diff --git a/third_party/exwm/default.nix b/third_party/exwm/default.nix new file mode 100644 index 000000000000..6daee882feda --- /dev/null +++ b/third_party/exwm/default.nix @@ -0,0 +1,14 @@ +{ depot, pkgs, lib, ... }: + +# special dance for overriding this into the fixed-point of emacs +# packages, but having it be separately buildable. + +pkgs.emacsPackages.callPackage + ({ trivialBuild, xelb }: trivialBuild { + pname = "depot-exwm"; + version = "canon"; + src = ./.; + + packageRequires = [ xelb ]; + }) +{ } diff --git a/third_party/exwm/exwm-background.el b/third_party/exwm/exwm-background.el new file mode 100644 index 000000000000..fa663d8fe637 --- /dev/null +++ b/third_party/exwm/exwm-background.el @@ -0,0 +1,199 @@ +;;; exwm-background.el --- X Background Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2024 Free Software Foundation, Inc. + +;; Author: Steven Allen <steven@stebalien.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module adds X background color setting support to EXWM. + +;; To use this module, load and enable it as follows: +;; (require 'exwm-background) +;; (exwm-background-enable) +;; +;; By default, this will apply the theme's background color. However, that +;; color can be customized via the `exwm-background-color' setting. + +;;; Code: + +(require 'exwm-core) + +(defcustom exwm-background-color nil + "Background color for Xorg." + :type '(choice + (color :tag "Background Color") + (const :tag "Default" nil)) + :group 'exwm + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default-toplevel-value symbol value) + (exwm-background--update))) + +(defconst exwm-background--properties '("_XROOTPMAP_ID" "_XSETROOT_ID" "ESETROOT_PMAP_ID") + "The background properties to set. +We can't need to set these so that compositing window managers +can correctly display the background color.") + +(defvar exwm-background--connection nil + "The X connection used for setting the background. +We use a separate connection as other background-setting tools +may kill this connection when they replace it.") + +(defvar exwm-background--pixmap nil + "Cached background pixmap.") + +(defvar exwm-background--atoms nil + "Cached background atoms.") + +(defun exwm-background--update (&rest _) + "Update the EXWM background." + + ;; Always reconnect as any tool that sets the background may have disconnected us (to force X to + ;; free resources). + (exwm-background--connect) + + (let ((gc (xcb:generate-id exwm-background--connection)) + (color (exwm--color->pixel (or exwm-background-color + (face-background 'default))))) + ;; Fill the pixmap. + (xcb:+request exwm-background--connection + (make-instance 'xcb:CreateGC + :cid gc :drawable exwm-background--pixmap + :value-mask (logior xcb:GC:Foreground + xcb:GC:GraphicsExposures) + :foreground color + :graphics-exposures 0)) + + (xcb:+request exwm-background--connection + (make-instance 'xcb:PolyFillRectangle + :gc gc :drawable exwm-background--pixmap + :rectangles + (list + (make-instance + 'xcb:RECTANGLE + :x 0 :y 0 :width 1 :height 1)))) + (xcb:+request exwm-background--connection (make-instance 'xcb:FreeGC :gc gc))) + + ;; Reapply it to force an update (also clobber anyone else who may have set it). + (xcb:+request exwm-background--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--root + :value-mask xcb:CW:BackPixmap + :background-pixmap exwm-background--pixmap)) + + (let (old) + ;; Collect old pixmaps so we can kill other background clients (all the background setting tools + ;; seem to do this). + (dolist (atom exwm-background--atoms) + (when-let* ((reply (xcb:+request-unchecked+reply exwm-background--connection + (make-instance 'xcb:GetProperty + :delete 0 + :window exwm--root + :property atom + :type xcb:Atom:PIXMAP + :long-offset 0 + :long-length 1))) + (value (vconcat (slot-value reply 'value))) + ((length= value 4)) + (pixmap (funcall (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4) + value 0)) + ((not (or (= pixmap exwm-background--pixmap) + (member pixmap old))))) + (push pixmap old))) + + ;; Change the background. + (dolist (atom exwm-background--atoms) + (xcb:+request exwm-background--connection + (make-instance 'xcb:ChangeProperty + :window exwm--root + :property atom + :type xcb:Atom:PIXMAP + :format 32 + :mode xcb:PropMode:Replace + :data-len 1 + :data + (funcall (if xcb:lsb + #'xcb:-pack-u4-lsb + #'xcb:-pack-u4) + exwm-background--pixmap)))) + + ;; Kill the old background clients. + (dolist (pixmap old) + (xcb:+request exwm-background--connection + (make-instance 'xcb:KillClient :resource pixmap)))) + + (xcb:flush exwm-background--connection)) + +(defun exwm-background--connected-p () + (and exwm-background--connection + (process-live-p (slot-value exwm-background--connection 'process)))) + +(defun exwm-background--connect () + (unless (exwm-background--connected-p) + (setq exwm-background--connection (xcb:connect)) + ;;prevent query message on exit + (set-process-query-on-exit-flag (slot-value exwm-background--connection 'process) nil) + + ;; Intern the background property atoms. + (setq exwm-background--atoms + (mapcar + (lambda (prop) (exwm--intern-atom prop exwm-background--connection)) + exwm-background--properties)) + + ;; Create the pixmap. + (setq exwm-background--pixmap (xcb:generate-id exwm-background--connection)) + (xcb:+request exwm-background--connection + (make-instance 'xcb:CreatePixmap + :depth + (slot-value + (xcb:+request-unchecked+reply exwm-background--connection + (make-instance 'xcb:GetGeometry :drawable exwm--root)) + 'depth) + :pid exwm-background--pixmap + :drawable exwm--root + :width 1 :height 1)))) + +(defun exwm-background--init () + "Initialize background module." + (exwm--log) + (add-hook 'enable-theme-functions 'exwm-background--update) + (add-hook 'disable-theme-functions 'exwm-background--update) + (exwm-background--update)) + +(defun exwm-background--exit () + "Uninitialize the background module." + (exwm--log) + (remove-hook 'enable-theme-functions 'exwm-background--update) + (remove-hook 'disable-theme-functions 'exwm-background--update) + (when (and exwm-background--connection + (slot-value exwm-background--connection 'connected)) + (xcb:disconnect exwm-background--connection)) + (setq exwm-background--pixmap nil + exwm-background--connection nil + exwm-background--atoms nil)) + +(defun exwm-background-enable () + "Enable background support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-background--init) + (add-hook 'exwm-exit-hook #'exwm-background--exit)) + +(provide 'exwm-background) + +;;; exwm-background.el ends here diff --git a/third_party/exwm/exwm-config.el b/third_party/exwm/exwm-config.el new file mode 100644 index 000000000000..a9f21e9c8c84 --- /dev/null +++ b/third_party/exwm/exwm-config.el @@ -0,0 +1,131 @@ +;;; exwm-config.el --- Predefined configurations -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module contains typical (yet minimal) configurations of EXWM. + +;;; Code: + +(require 'exwm) +(require 'ido) + +(define-obsolete-function-alias 'exwm-config-default + #'exwm-config-example "27.1") + +(defun exwm-config-example () + "Default configuration of EXWM." + ;; Set the initial workspace number. + (unless (get 'exwm-workspace-number 'saved-value) + (setq exwm-workspace-number 4)) + ;; Make class name the buffer name + (add-hook 'exwm-update-class-hook + (lambda () + (exwm-workspace-rename-buffer exwm-class-name))) + ;; Global keybindings. + (unless (get 'exwm-input-global-keys 'saved-value) + (setq exwm-input-global-keys + `( + ;; 's-r': Reset (to line-mode). + ([?\s-r] . exwm-reset) + ;; 's-w': Switch workspace. + ([?\s-w] . exwm-workspace-switch) + ;; 's-&': Launch application. + ([?\s-&] . (lambda (command) + (interactive (list (read-shell-command "$ "))) + (start-process-shell-command command nil command))) + ;; 's-N': Switch to certain workspace. + ,@(mapcar (lambda (i) + `(,(kbd (format "s-%d" i)) . + (lambda () + (interactive) + (exwm-workspace-switch-create ,i)))) + (number-sequence 0 9))))) + ;; Line-editing shortcuts + (unless (get 'exwm-input-simulation-keys 'saved-value) + (setq exwm-input-simulation-keys + '(([?\C-b] . [left]) + ([?\C-f] . [right]) + ([?\C-p] . [up]) + ([?\C-n] . [down]) + ([?\C-a] . [home]) + ([?\C-e] . [end]) + ([?\M-v] . [prior]) + ([?\C-v] . [next]) + ([?\C-d] . [delete]) + ([?\C-k] . [S-end delete])))) + ;; Enable EXWM + (exwm-enable) + ;; Configure Ido + (exwm-config-ido) + ;; Other configurations + (exwm-config-misc)) + +(defun exwm-config--fix/ido-buffer-window-other-frame () + "Fix `ido-buffer-window-other-frame'." + (defalias 'exwm-config-ido-buffer-window-other-frame + (symbol-function #'ido-buffer-window-other-frame)) + (defun ido-buffer-window-other-frame (buffer) + "This is a version redefined by EXWM. + +You can find the original one at `exwm-config-ido-buffer-window-other-frame'." + (with-current-buffer (window-buffer (selected-window)) + (if (and (derived-mode-p 'exwm-mode) + exwm--floating-frame) + ;; Switch from a floating frame. + (with-current-buffer buffer + (if (and (derived-mode-p 'exwm-mode) + exwm--floating-frame + (eq exwm--frame exwm-workspace--current)) + ;; Switch to another floating frame. + (frame-root-window exwm--floating-frame) + ;; Do not switch if the buffer is not on the current workspace. + (or (get-buffer-window buffer exwm-workspace--current) + (selected-window)))) + (with-current-buffer buffer + (when (derived-mode-p 'exwm-mode) + (if (eq exwm--frame exwm-workspace--current) + (when exwm--floating-frame + ;; Switch to a floating frame on the current workspace. + (frame-selected-window exwm--floating-frame)) + ;; Do not switch to exwm-mode buffers on other workspace (which + ;; won't work unless `exwm-layout-show-all-buffers' is set) + (unless exwm-layout-show-all-buffers + (selected-window))))))))) + +(defun exwm-config-ido () + "Configure Ido to work with EXWM." + (ido-mode 1) + (add-hook 'exwm-init-hook #'exwm-config--fix/ido-buffer-window-other-frame)) + +(defun exwm-config-misc () + "Other configurations." + ;; Make more room + (menu-bar-mode -1) + (tool-bar-mode -1) + (scroll-bar-mode -1) + (fringe-mode 1)) + + + +(provide 'exwm-config) + +;;; exwm-config.el ends here diff --git a/third_party/exwm/exwm-core.el b/third_party/exwm/exwm-core.el new file mode 100644 index 000000000000..e0d644d941ed --- /dev/null +++ b/third_party/exwm/exwm-core.el @@ -0,0 +1,411 @@ +;;; exwm-core.el --- Core definitions -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module includes core definitions of variables, macros, functions, etc +;; shared by various other modules. + +;;; Code: + +(require 'kmacro) + +(require 'xcb) +(require 'xcb-icccm) +(require 'xcb-ewmh) +(require 'xcb-debug) + +(defgroup exwm-debug nil + "Debugging." + :group 'exwm) + +(defcustom exwm-debug-log-time-function #'exwm-debug-log-uptime + "Function used for generating timestamps in `exwm-debug' logs. + +Here are some predefined candidates: +`exwm-debug-log-uptime': Display the uptime of this Emacs instance. +`exwm-debug-log-time': Display time of day. +`nil': Disable timestamp." + :type `(choice (const :tag "Emacs uptime" ,#'exwm-debug-log-uptime) + (const :tag "Time of day" ,#'exwm-debug-log-time) + (const :tag "Off" nil) + (function :tag "Other")) + :set (lambda (symbol value) + (set-default symbol value) + ;; Also change the format for XELB to make logs consistent + ;; (as they share the same buffer). + (setq xcb-debug:log-time-function value))) + +(defalias 'exwm-debug-log-uptime 'xcb-debug:log-uptime + "Add uptime to `exwm-debug' logs.") + +(defalias 'exwm-debug-log-time 'xcb-debug:log-time + "Add time of day to `exwm-debug' logs.") + +(defvar exwm--connection nil "X connection.") + +(defvar exwm--terminal nil + "Terminal corresponding to `exwm--connection'.") + +(defvar exwm--wmsn-window nil + "An X window owning the WM_S0 selection.") + +(defvar exwm--wmsn-acquire-timeout 3 + "Number of seconds to wait for other window managers to release the selection.") + +(defvar exwm--guide-window nil + "An X window separating workspaces and X windows.") + +(defvar exwm--id-buffer-alist nil "Alist of (<X window ID> . <Emacs buffer>).") + +(defvar exwm--root nil "Root window.") + +(defvar exwm-input--global-prefix-keys) +(defvar exwm-input--simulation-keys) +(defvar exwm-input-line-mode-passthrough) +(defvar exwm-input-prefix-keys) +(declare-function exwm-input--fake-key "exwm-input.el" (event)) +(declare-function exwm-input--on-KeyPress-line-mode "exwm-input.el" + (key-press raw-data)) +(declare-function exwm-floating-hide "exwm-floating.el") +(declare-function exwm-floating-toggle-floating "exwm-floating.el") +(declare-function exwm-input-release-keyboard "exwm-input.el") +(declare-function exwm-input-send-next-key "exwm-input.el" (times)) +(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id)) +(declare-function exwm-layout-toggle-mode-line "exwm-layout.el") +(declare-function exwm-manage--kill-buffer-query-function "exwm-manage.el") +(declare-function exwm-workspace-move-window "exwm-workspace.el" + (frame-or-index &optional id)) + +(define-minor-mode exwm-debug + "Debug-logging enabled if non-nil." + :global t + :group 'exwm-debug) + +(defmacro exwm--debug (&rest forms) + "Evaluate FORMS if mode `exwm-debug' is active." + (when exwm-debug `(progn ,@forms))) + +(defmacro exwm--log (&optional format-string &rest objects) + "Emit a message prepending the name of the function being executed. + +FORMAT-STRING is a string specifying the message to output, as in +`format'. The OBJECTS arguments specify the substitutions." + (unless format-string (setq format-string "")) + `(when exwm-debug + (xcb-debug:message ,(concat "%s%s:\t" format-string "\n") + (if exwm-debug-log-time-function + (funcall exwm-debug-log-time-function) + "") + (xcb-debug:compile-time-function-name) + ,@objects) + nil)) + +(defsubst exwm--id->buffer (id) + "X window ID => Emacs buffer." + (declare (indent defun)) + (cdr (assoc id exwm--id-buffer-alist))) + +(defsubst exwm--buffer->id (buffer) + "Emacs buffer BUFFER => X window ID." + (declare (indent defun)) + (car (rassoc buffer exwm--id-buffer-alist))) + +(defun exwm--lock (&rest _args) + "Lock (disable all events)." + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--root + :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:NoEvent)) + (xcb:flush exwm--connection)) + +(defun exwm--unlock (&rest _args) + "Unlock (enable all events)." + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--root + :value-mask xcb:CW:EventMask + :event-mask (eval-when-compile + (logior xcb:EventMask:SubstructureRedirect + xcb:EventMask:StructureNotify)))) + (xcb:flush exwm--connection)) + +(defun exwm--set-geometry (xwin x y width height) + "Set the geometry of X window XWIN to WIDTHxHEIGHT+X+Y. + +Nil can be passed as placeholder." + (exwm--log "Setting #x%x to %sx%s+%s+%s" xwin width height x y) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window xwin + :value-mask (logior (if x xcb:ConfigWindow:X 0) + (if y xcb:ConfigWindow:Y 0) + (if width xcb:ConfigWindow:Width 0) + (if height xcb:ConfigWindow:Height 0)) + :x x :y y :width width :height height))) + +(defun exwm--intern-atom (atom &optional conn) + "Intern X11 ATOM. +If CONN is non-nil, use it instead of the value of the variable +`exwm--connection'." + (slot-value (xcb:+request-unchecked+reply (or conn exwm--connection) + (make-instance 'xcb:InternAtom + :only-if-exists 0 + :name-len (length atom) + :name atom)) + 'atom)) + +(defmacro exwm--defer (secs function &rest args) + "Defer the execution of FUNCTION. + +The action is to call FUNCTION with arguments ARGS. If Emacs is not idle, +defer the action until Emacs is idle. Otherwise, defer the action until at +least SECS seconds later." + `(run-with-idle-timer (+ (float-time (or (current-idle-time) + (seconds-to-time (- ,secs)))) + ,secs) + nil + ,function + ,@args)) + +(defsubst exwm--terminal-p (&optional frame) + "Return t when FRAME's terminal is EXWM's terminal. +If FRAME is null, use selected frame." + (declare (indent defun)) + (eq exwm--terminal (frame-terminal frame))) + +(defun exwm--get-client-event-mask () + "Return event mask set on all managed windows." + (logior xcb:EventMask:StructureNotify + xcb:EventMask:PropertyChange + (if mouse-autoselect-window + xcb:EventMask:EnterWindow 0))) + +(defun exwm--color->pixel (color) + "Convert COLOR to PIXEL (index in TrueColor colormap)." + (when (and color + (eq (x-display-visual-class) 'true-color)) + (let ((rgb (color-values color))) + (logior (ash (ash (pop rgb) -8) 16) + (ash (ash (pop rgb) -8) 8) + (ash (pop rgb) -8))))) + +(defun exwm--get-visual-depth-colormap (conn id) + "Get visual, depth and colormap from X window ID. +Return a three element list with the respective results. + +If CONN is non-nil, use it instead of the value of the variable +`exwm--connection'." + (let (ret-visual ret-depth ret-colormap) + (with-slots (visual colormap) + (xcb:+request-unchecked+reply conn + (make-instance 'xcb:GetWindowAttributes :window id)) + (setq ret-visual visual) + (setq ret-colormap colormap)) + (with-slots (depth) + (xcb:+request-unchecked+reply conn + (make-instance 'xcb:GetGeometry :drawable id)) + (setq ret-depth depth)) + (list ret-visual ret-depth ret-colormap))) + +;; Internal variables +(defvar-local exwm--id nil) ;window ID +(defvar-local exwm--configurations nil) ;initial configurations. +(defvar-local exwm--frame nil) ;workspace frame +(defvar-local exwm--floating-frame nil) ;floating frame +(defvar-local exwm--mode-line-format nil) ;save mode-line-format +(defvar-local exwm--floating-frame-position nil) ;set when hidden. +(defvar-local exwm--fixed-size nil) ;fixed size +(defvar-local exwm--selected-input-mode 'line-mode + "Input mode as selected by the user. +One of `line-mode' or `char-mode'.") +(defvar-local exwm--input-mode 'line-mode + "Actual input mode, i.e. whether mouse and keyboard are grabbed.") +;; Properties +(defvar-local exwm--desktop nil "_NET_WM_DESKTOP.") +(defvar-local exwm-window-type nil "_NET_WM_WINDOW_TYPE.") +(defvar-local exwm--geometry nil) +(defvar-local exwm-class-name nil "Class name in WM_CLASS.") +(defvar-local exwm-instance-name nil "Instance name in WM_CLASS.") +(defvar-local exwm-title nil "Window title (either _NET_WM_NAME or WM_NAME).") +(defvar-local exwm--title-is-utf8 nil) +(defvar-local exwm-transient-for nil "WM_TRANSIENT_FOR.") +(defvar-local exwm--protocols nil) +(defvar-local exwm-state xcb:icccm:WM_STATE:NormalState "WM_STATE.") +(defvar-local exwm--ewmh-state nil "_NET_WM_STATE.") +;; _NET_WM_NORMAL_HINTS +(defvar-local exwm--normal-hints-x nil) +(defvar-local exwm--normal-hints-y nil) +(defvar-local exwm--normal-hints-width nil) +(defvar-local exwm--normal-hints-height nil) +(defvar-local exwm--normal-hints-min-width nil) +(defvar-local exwm--normal-hints-min-height nil) +(defvar-local exwm--normal-hints-max-width nil) +(defvar-local exwm--normal-hints-max-height nil) +;; (defvar-local exwm--normal-hints-win-gravity nil) +;; WM_HINTS +(defvar-local exwm--hints-input nil) +(defvar-local exwm--hints-urgency nil) +;; _MOTIF_WM_HINTS +(defvar-local exwm--mwm-hints-decorations t) + +(defvar exwm-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-d\C-l" #'xcb-debug:clear) + (define-key map "\C-c\C-d\C-m" #'xcb-debug:mark) + (define-key map "\C-c\C-d\C-t" #'exwm-debug) + (define-key map "\C-c\C-f" #'exwm-layout-set-fullscreen) + (define-key map "\C-c\C-h" #'exwm-floating-hide) + (define-key map "\C-c\C-k" #'exwm-input-release-keyboard) + (define-key map "\C-c\C-m" #'exwm-workspace-move-window) + (define-key map "\C-c\C-q" #'exwm-input-send-next-key) + (define-key map "\C-c\C-t\C-f" #'exwm-floating-toggle-floating) + (define-key map "\C-c\C-t\C-m" #'exwm-layout-toggle-mode-line) + map) + "Keymap for `exwm-mode'.") + +(defvar exwm--kmacro-map + (let ((map (make-sparse-keymap))) + (define-key map [t] + (lambda () + (interactive) + (cond + ((or exwm-input-line-mode-passthrough + ;; Do not test `exwm-input--during-command'. + (active-minibuffer-window) + (memq last-input-event exwm-input--global-prefix-keys) + (memq last-input-event exwm-input-prefix-keys) + (lookup-key exwm-mode-map (vector last-input-event)) + (gethash last-input-event exwm-input--simulation-keys)) + (set-transient-map (make-composed-keymap (list exwm-mode-map + global-map))) + (push last-input-event unread-command-events)) + (t + (exwm-input--fake-key last-input-event))))) + map) + "Keymap used when executing keyboard macros.") + +;; This menu mainly acts as an reminder for users. Thus it should be as +;; detailed as possible, even some entries do not make much sense here. +;; Also, inactive entries should be disabled rather than hidden. +(easy-menu-define exwm-mode-menu exwm-mode-map + "Menu for `exwm-mode'." + '("EXWM" + "---" + "*General*" + "---" + ["Toggle floating" exwm-floating-toggle-floating] + ["Toggle fullscreen mode" exwm-layout-toggle-fullscreen] + ["Hide window" exwm-floating-hide exwm--floating-frame] + ["Close window" (kill-buffer (current-buffer))] + + "---" + "*Resizing*" + "---" + ["Toggle mode-line" exwm-layout-toggle-mode-line] + ["Enlarge window vertically" exwm-layout-enlarge-window] + ["Enlarge window horizontally" exwm-layout-enlarge-window-horizontally] + ["Shrink window vertically" exwm-layout-shrink-window] + ["Shrink window horizontally" exwm-layout-shrink-window-horizontally] + + "---" + "*Keyboard*" + "---" + ["Toggle keyboard mode" exwm-input-toggle-keyboard] + ["Send key" exwm-input-send-next-key (eq exwm--input-mode 'line-mode)] + ;; This is merely a reference. + ("Send simulation key" :filter + (lambda (&rest _args) + (let (result) + (maphash + (lambda (key value) + (when (sequencep key) + (setq result (append result + `([ + ,(format "Send '%s'" + (key-description value)) + (lambda () + (interactive) + (dolist (i ',value) + (exwm-input--fake-key i))) + :keys ,(key-description key)]))))) + exwm-input--simulation-keys) + result))) + + ["Define global binding" exwm-input-set-key] + + "---" + "*Workspace*" + "---" + ["Add workspace" exwm-workspace-add] + ["Delete current workspace" exwm-workspace-delete] + ["Move workspace to" exwm-workspace-move] + ["Swap workspaces" exwm-workspace-swap] + ["Move X window to" exwm-workspace-move-window] + ["Move X window from" exwm-workspace-switch-to-buffer] + ["Toggle minibuffer" exwm-workspace-toggle-minibuffer] + ["Switch workspace" exwm-workspace-switch] + ;; Place this entry at bottom to avoid selecting others by accident. + ("Switch to" :filter + (lambda (&rest _args) + (mapcar (lambda (i) + `[,(format "Workspace %d" i) + (lambda () + (interactive) + (exwm-workspace-switch ,i)) + (/= ,i exwm-workspace-current-index)]) + (number-sequence 0 (1- (exwm-workspace--count)))))))) + +(define-derived-mode exwm-mode nil "EXWM" + "Major mode for managing X windows. + +\\{exwm-mode-map}" + ;; + (setq mode-name + '(:eval (propertize "EXWM" 'face + (when (cl-some (lambda (i) + (frame-parameter i 'exwm-urgency)) + exwm-workspace--list) + 'font-lock-warning-face)))) + ;; Change major-mode is not allowed + (add-hook 'change-major-mode-hook #'kill-buffer nil t) + ;; Kill buffer -> close window + (add-hook 'kill-buffer-query-functions + #'exwm-manage--kill-buffer-query-function nil t) + ;; Redirect events when executing keyboard macros. + (push `(executing-kbd-macro . ,exwm--kmacro-map) + minor-mode-overriding-map-alist) + (setq buffer-read-only t + cursor-type nil + left-margin-width nil + right-margin-width nil + left-fringe-width 0 + right-fringe-width 0 + vertical-scroll-bar nil)) + + + +(provide 'exwm-core) + +;;; exwm-core.el ends here diff --git a/third_party/exwm/exwm-floating.el b/third_party/exwm/exwm-floating.el new file mode 100644 index 000000000000..34d06a30db09 --- /dev/null +++ b/third_party/exwm/exwm-floating.el @@ -0,0 +1,780 @@ +;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module deals with the conversion between floating and non-floating +;; states and implements moving/resizing operations on floating windows. + +;;; Code: + +(require 'xcb-cursor) +(require 'exwm-core) + +(defgroup exwm-floating nil + "Floating." + :group 'exwm) + +(defcustom exwm-floating-setup-hook nil + "Normal hook run when an X window has been made floating. +This hook runs in the context of the corresponding buffer." + :type 'hook) + +(defcustom exwm-floating-exit-hook nil + "Normal hook run when an X window has exited floating state. +This hook runs in the context of the corresponding buffer." + :type 'hook) + +(defcustom exwm-floating-border-color "navy" + "Border color of floating windows." + :type 'color + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + ;; Change border color for all floating X windows. + (when exwm--connection + (let ((border-pixel (exwm--color->pixel value))) + (when border-pixel + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when exwm--floating-frame + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window + (frame-parameter exwm--floating-frame + 'exwm-container) + :value-mask xcb:CW:BorderPixel + :border-pixel border-pixel))))) + (xcb:flush exwm--connection)))))) + +(defcustom exwm-floating-border-width 1 + "Border width of floating windows." + :type '(integer + :validate (lambda (widget) + (when (< (widget-value widget) 0) + (widget-put widget :error "Border width is at least 0") + widget))) + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (let ((delta (- value exwm-floating-border-width)) + container) + (set-default symbol value) + ;; Change border width for all floating X windows. + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when exwm--floating-frame + (setq container (frame-parameter exwm--floating-frame + 'exwm-container)) + (with-slots (x y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window container + :value-mask + (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Y + xcb:ConfigWindow:BorderWidth) + :border-width value + :x (- x delta) + :y (- y delta))))))) + (when exwm--connection + (xcb:flush exwm--connection))))) + +;; Cursors for moving/resizing a window +(defvar exwm-floating--cursor-move nil) +(defvar exwm-floating--cursor-top-left nil) +(defvar exwm-floating--cursor-top nil) +(defvar exwm-floating--cursor-top-right nil) +(defvar exwm-floating--cursor-right nil) +(defvar exwm-floating--cursor-bottom-right nil) +(defvar exwm-floating--cursor-bottom nil) +(defvar exwm-floating--cursor-bottom-left nil) +(defvar exwm-floating--cursor-left nil) + +(defvar exwm-floating--moveresize-calculate nil + "Calculate move/resize parameters [buffer event-mask x y width height].") + +(defvar exwm-workspace--current) +(defvar exwm-workspace--frame-y-offset) +(defvar exwm-workspace--window-y-offset) +(declare-function exwm-layout--hide "exwm-layout.el" (id)) +(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) +(declare-function exwm-layout--refresh "exwm-layout.el" ()) +(declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) +(declare-function exwm-workspace--position "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--update-offsets "exwm-workspace.el" ()) +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) + +(defun exwm-floating--set-allowed-actions (id tilling) + "Set _NET_WM_ALLOWED_ACTIONS." + (exwm--log "#x%x" id) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS + :window id + :data (if tilling + (vector xcb:Atom:_NET_WM_ACTION_MINIMIZE + xcb:Atom:_NET_WM_ACTION_FULLSCREEN + xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP + xcb:Atom:_NET_WM_ACTION_CLOSE) + (vector xcb:Atom:_NET_WM_ACTION_MOVE + xcb:Atom:_NET_WM_ACTION_RESIZE + xcb:Atom:_NET_WM_ACTION_MINIMIZE + xcb:Atom:_NET_WM_ACTION_FULLSCREEN + xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP + xcb:Atom:_NET_WM_ACTION_CLOSE))))) + +(defun exwm-floating--set-floating (id) + "Make window ID floating." + (let ((window (get-buffer-window (exwm--id->buffer id)))) + (when window + ;; Hide the non-floating X window first. + (set-window-buffer window (other-buffer nil t)))) + (let* ((original-frame (buffer-local-value 'exwm--frame + (exwm--id->buffer id))) + ;; Create new frame + (frame (with-current-buffer + (or (get-buffer "*scratch*") + (progn + (set-buffer-major-mode + (get-buffer-create "*scratch*")) + (get-buffer "*scratch*"))) + (make-frame + `((minibuffer . ,(minibuffer-window exwm--frame)) + (tab-bar-lines . 0) + (tab-bar-lines-keep-state . t) + (left . ,(* window-min-width -10000)) + (top . ,(* window-min-height -10000)) + (width . ,window-min-width) + (height . ,window-min-height) + (unsplittable . t))))) ;and fix the size later + (outer-id (string-to-number (frame-parameter frame 'outer-window-id))) + (window-id (string-to-number (frame-parameter frame 'window-id))) + (frame-container (xcb:generate-id exwm--connection)) + (window (frame-first-window frame)) ;and it's the only window + (x (slot-value exwm--geometry 'x)) + (y (slot-value exwm--geometry 'y)) + (width (slot-value exwm--geometry 'width)) + (height (slot-value exwm--geometry 'height))) + ;; Force drawing menu-bar & tool-bar. + (redisplay t) + (exwm-workspace--update-offsets) + (exwm--log "Floating geometry (original): %dx%d%+d%+d" width height x y) + ;; Save frame parameters. + (set-frame-parameter frame 'exwm-outer-id outer-id) + (set-frame-parameter frame 'exwm-id window-id) + (set-frame-parameter frame 'exwm-container frame-container) + ;; Fix illegal parameters + ;; FIXME: check normal hints restrictions + (with-slots ((x* x) (y* y) (width* width) (height* height)) + (exwm-workspace--workarea original-frame) + ;; Center floating windows + (when (and (or (= x 0) (= x x*)) + (or (= y 0) (= y y*))) + (let ((buffer (exwm--id->buffer exwm-transient-for)) + window edges) + (when (and buffer (setq window (get-buffer-window buffer))) + (setq edges (window-inside-absolute-pixel-edges window)) + (unless (and (<= width (- (elt edges 2) (elt edges 0))) + (<= height (- (elt edges 3) (elt edges 1)))) + (setq edges nil))) + (if edges + ;; Put at the center of leading window + (setq x (+ x* (/ (- (elt edges 2) (elt edges 0) width) 2)) + y (+ y* (/ (- (elt edges 3) (elt edges 1) height) 2))) + ;; Put at the center of screen + (setq x (/ (- width* width) 2) + y (/ (- height* height) 2))))) + (if (> width width*) + ;; Too wide + (progn (setq x x* + width width*)) + ;; Invalid width + (when (= 0 width) (setq width (/ width* 2))) + ;; Make sure at least half of the window is visible + (unless (< x* (+ x (/ width 2)) (+ x* width*)) + (setq x (+ x* (/ (- width* width) 2))))) + (if (> height height*) + ;; Too tall + (setq y y* + height height*) + ;; Invalid height + (when (= 0 height) (setq height (/ height* 2))) + ;; Make sure at least half of the window is visible + (unless (< y* (+ y (/ height 2)) (+ y* height*)) + (setq y (+ y* (/ (- height* height) 2))))) + ;; The geometry can be overridden by user options. + (let ((x** (plist-get exwm--configurations 'x)) + (y** (plist-get exwm--configurations 'y)) + (width** (plist-get exwm--configurations 'width)) + (height** (plist-get exwm--configurations 'height))) + (if (integerp x**) + (setq x (+ x* x**)) + (when (and (floatp x**) + (>= 1 x** 0)) + (setq x (+ x* (round (* x** width*)))))) + (if (integerp y**) + (setq y (+ y* y**)) + (when (and (floatp y**) + (>= 1 y** 0)) + (setq y (+ y* (round (* y** height*)))))) + (if (integerp width**) + (setq width width**) + (when (and (floatp width**) + (> 1 width** 0)) + (setq width (max 1 (round (* width** width*)))))) + (if (integerp height**) + (setq height height**) + (when (and (floatp height**) + (> 1 height** 0)) + (setq height (max 1 (round (* height** height*)))))))) + (exwm--set-geometry id x y nil nil) + (xcb:flush exwm--connection) + (exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y) + ;; Fit frame to client + ;; It seems we have to make the frame invisible in order to resize it + ;; timely. + ;; The frame will be made visible by `select-frame-set-input-focus'. + (make-frame-invisible frame) + (let* ((edges (window-inside-pixel-edges window)) + (frame-width (+ width (- (frame-pixel-width frame) + (- (elt edges 2) (elt edges 0))))) + (frame-height (+ height (- (frame-pixel-height frame) + (- (elt edges 3) (elt edges 1))) + ;; Use `frame-outer-height' in the future. + exwm-workspace--frame-y-offset)) + (floating-mode-line (plist-get exwm--configurations + 'floating-mode-line)) + (floating-header-line (plist-get exwm--configurations + 'floating-header-line)) + (border-pixel (exwm--color->pixel exwm-floating-border-color))) + (if floating-mode-line + (setq exwm--mode-line-format (or exwm--mode-line-format + mode-line-format) + mode-line-format floating-mode-line) + (if (and (not (plist-member exwm--configurations 'floating-mode-line)) + exwm--mwm-hints-decorations) + (when exwm--mode-line-format + (setq mode-line-format exwm--mode-line-format)) + ;; The mode-line need to be hidden in floating mode. + (setq frame-height (- frame-height (window-mode-line-height + (frame-root-window frame))) + exwm--mode-line-format (or exwm--mode-line-format + mode-line-format) + mode-line-format nil))) + (if floating-header-line + (setq header-line-format floating-header-line) + (if (and (not (plist-member exwm--configurations + 'floating-header-line)) + exwm--mwm-hints-decorations) + (setq header-line-format nil) + ;; The header-line need to be hidden in floating mode. + (setq frame-height (- frame-height (window-header-line-height + (frame-root-window frame))) + header-line-format nil))) + (set-frame-size frame frame-width frame-height t) + ;; Create the frame container as the parent of the frame. + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid frame-container + :parent exwm--root + :x x + :y (- y exwm-workspace--window-y-offset) + :width width + :height height + :border-width + (with-current-buffer (exwm--id->buffer id) + (let ((border-witdh (plist-get exwm--configurations + 'border-width))) + (if (and (integerp border-witdh) + (>= border-witdh 0)) + border-witdh + exwm-floating-border-width))) + :class xcb:WindowClass:InputOutput + :visual 0 + :value-mask (logior xcb:CW:BackPixmap + (if border-pixel + xcb:CW:BorderPixel 0) + xcb:CW:OverrideRedirect) + :background-pixmap xcb:BackPixmap:ParentRelative + :border-pixel border-pixel + :override-redirect 1)) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window frame-container + :data + (format "EXWM floating frame container for 0x%x" id))) + ;; Map it. + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window frame-container)) + ;; Put the X window right above this frame container. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window id + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling frame-container + :stack-mode xcb:StackMode:Above))) + ;; Reparent this frame to its container. + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window outer-id :parent frame-container :x 0 :y 0)) + (exwm-floating--set-allowed-actions id nil) + (xcb:flush exwm--connection) + ;; Set window/buffer + (with-current-buffer (exwm--id->buffer id) + (setq window-size-fixed exwm--fixed-size + exwm--floating-frame frame) + ;; Do the refresh manually. + (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) + (set-window-buffer window (current-buffer)) ;this changes current buffer + (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) + (set-window-dedicated-p window t) + (exwm-layout--show id window)) + (with-current-buffer (exwm--id->buffer id) + (if (exwm-layout--iconic-state-p id) + ;; Hide iconic floating X windows. + (exwm-floating-hide) + (with-selected-frame exwm--frame + (exwm-layout--refresh))) + (select-frame-set-input-focus frame)) + ;; FIXME: Strangely, the Emacs frame can move itself at this point + ;; when there are left/top struts set. Force resetting its + ;; position seems working, but it'd better to figure out why. + ;; FIXME: This also happens in another case (#220) where the cause is + ;; still unclear. + (exwm--set-geometry outer-id 0 0 nil nil) + (xcb:flush exwm--connection)) + (with-current-buffer (exwm--id->buffer id) + (run-hooks 'exwm-floating-setup-hook)) + ;; Redraw the frame. + (redisplay t)) + +(defun exwm-floating--unset-floating (id) + "Make window ID non-floating." + (exwm--log "#x%x" id) + (let ((buffer (exwm--id->buffer id))) + (with-current-buffer buffer + (when exwm--floating-frame + ;; The X window is already mapped. + ;; Unmap the X window. + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:NoEvent)) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window id)) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask (exwm--get-client-event-mask))) + ;; Reparent the floating frame back to the root window. + (let ((frame-id (frame-parameter exwm--floating-frame 'exwm-outer-id)) + (frame-container (frame-parameter exwm--floating-frame + 'exwm-container))) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window frame-id)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window frame-id + :parent exwm--root + :x 0 :y 0)) + ;; Also destroy its container. + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow :window frame-container)))) + ;; Place the X window just above the reference X window. + ;; (the stacking order won't change from now on). + ;; Also hide the possible floating border. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window id + :value-mask (logior xcb:ConfigWindow:BorderWidth + xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :border-width 0 + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Above))) + (exwm-floating--set-allowed-actions id t) + (xcb:flush exwm--connection) + (with-current-buffer buffer + (when exwm--floating-frame ;from floating to non-floating + (set-window-dedicated-p (frame-first-window exwm--floating-frame) nil) + ;; Select a tiling window and delete the old frame. + (select-window (frame-selected-window exwm-workspace--current)) + (with-current-buffer buffer + (delete-frame exwm--floating-frame)))) + (with-current-buffer buffer + (setq window-size-fixed nil + exwm--floating-frame nil) + (if (not (plist-member exwm--configurations 'tiling-mode-line)) + (when exwm--mode-line-format + (setq mode-line-format exwm--mode-line-format)) + (setq exwm--mode-line-format (or exwm--mode-line-format + mode-line-format) + mode-line-format (plist-get exwm--configurations + 'tiling-mode-line))) + (if (not (plist-member exwm--configurations 'tiling-header-line)) + (setq header-line-format nil) + (setq header-line-format (plist-get exwm--configurations + 'tiling-header-line)))) + ;; Only show X windows in normal state. + (unless (exwm-layout--iconic-state-p) + (pop-to-buffer-same-window buffer))) + (with-current-buffer (exwm--id->buffer id) + (run-hooks 'exwm-floating-exit-hook))) + +;;;###autoload +(cl-defun exwm-floating-toggle-floating () + "Toggle the current window between floating and non-floating states." + (interactive) + (exwm--log) + (unless (derived-mode-p 'exwm-mode) + (cl-return-from exwm-floating-toggle-floating)) + (with-current-buffer (window-buffer) + (if exwm--floating-frame + (exwm-floating--unset-floating exwm--id) + (exwm-floating--set-floating exwm--id)))) + +;;;###autoload +(defun exwm-floating-hide () + "Hide the current floating X window (which would show again when selected)." + (interactive) + (exwm--log) + (when (and (derived-mode-p 'exwm-mode) + exwm--floating-frame) + (exwm-layout--hide exwm--id) + (select-frame-set-input-focus exwm-workspace--current))) + +(defun exwm-floating--start-moveresize (id &optional type) + "Start move/resize." + (exwm--log "#x%x" id) + (let ((buffer-or-id (or (exwm--id->buffer id) id)) + frame container-or-id x y width height cursor) + (if (bufferp buffer-or-id) + ;; Managed. + (with-current-buffer buffer-or-id + (setq frame exwm--floating-frame + container-or-id (frame-parameter exwm--floating-frame + 'exwm-container))) + ;; Unmanaged. + (setq container-or-id id)) + (when (and container-or-id + ;; Test if the pointer can be grabbed + (= xcb:GrabStatus:Success + (slot-value + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GrabPointer + :owner-events 0 + :grab-window container-or-id + :event-mask xcb:EventMask:NoEvent + :pointer-mode xcb:GrabMode:Async + :keyboard-mode xcb:GrabMode:Async + :confine-to xcb:Window:None + :cursor xcb:Cursor:None + :time xcb:Time:CurrentTime)) + 'status))) + (with-slots (root-x root-y win-x win-y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryPointer :window id)) + (if (not (bufferp buffer-or-id)) + ;; Unmanaged. + (unless (eq type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) + (with-slots ((width* width) + (height* height)) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry :drawable id)) + (setq width width* + height height*))) + ;; Managed. + (select-window (frame-first-window frame)) ;transfer input focus + (setq width (frame-pixel-width frame) + height (frame-pixel-height frame)) + (unless type + ;; Determine the resize type according to the pointer position + ;; Clicking the center 1/3 part to resize has no effect + (setq x (/ (* 3 win-x) (float width)) + y (/ (* 3 win-y) (float height)) + type (cond ((and (< x 1) (< y 1)) + xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) + ((and (> x 2) (< y 1)) + xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) + ((and (> x 2) (> y 2)) + xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) + ((and (< x 1) (> y 2)) + xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) + ((> x 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) + ((> y 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) + ((< x 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) + ((< y 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP))))) + (if (not type) + (exwm-floating--stop-moveresize) + (cond ((= type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) + (setq cursor exwm-floating--cursor-move + exwm-floating--moveresize-calculate + (lambda (x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Y)) + (- x win-x) (- y win-y) 0 0)))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) + (setq cursor exwm-floating--cursor-top-left + exwm-floating--moveresize-calculate + (lambda (x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Y + xcb:ConfigWindow:Width + xcb:ConfigWindow:Height)) + (- x win-x) (- y win-y) + (- (+ root-x width) x) + (- (+ root-y height) y))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP) + (setq cursor exwm-floating--cursor-top + exwm-floating--moveresize-calculate + (lambda (_x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:Y + xcb:ConfigWindow:Height)) + 0 (- y win-y) 0 (- (+ root-y height) y))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) + (setq cursor exwm-floating--cursor-top-right + exwm-floating--moveresize-calculate + (lambda (x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:Y + xcb:ConfigWindow:Width + xcb:ConfigWindow:Height)) + 0 (- y win-y) (- x (- root-x width)) + (- (+ root-y height) y))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) + (setq cursor exwm-floating--cursor-right + exwm-floating--moveresize-calculate + (lambda (x _y) + (vector buffer-or-id + xcb:ConfigWindow:Width + 0 0 (- x (- root-x width)) 0)))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) + (setq cursor exwm-floating--cursor-bottom-right + exwm-floating--moveresize-calculate + (lambda (x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:Width + xcb:ConfigWindow:Height)) + 0 0 (- x (- root-x width)) + (- y (- root-y height)))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) + (setq cursor exwm-floating--cursor-bottom + exwm-floating--moveresize-calculate + (lambda (_x y) + (vector buffer-or-id + xcb:ConfigWindow:Height + 0 0 0 (- y (- root-y height)))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) + (setq cursor exwm-floating--cursor-bottom-left + exwm-floating--moveresize-calculate + (lambda (x y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Width + xcb:ConfigWindow:Height)) + (- x win-x) + 0 + (- (+ root-x width) x) + (- y (- root-y height)))))) + ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) + (setq cursor exwm-floating--cursor-left + exwm-floating--moveresize-calculate + (lambda (x _y) + (vector buffer-or-id + (eval-when-compile + (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Width)) + (- x win-x) 0 (- (+ root-x width) x) 0))))) + ;; Select events and change cursor (should always succeed) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GrabPointer + :owner-events 0 :grab-window container-or-id + :event-mask (eval-when-compile + (logior xcb:EventMask:ButtonRelease + xcb:EventMask:ButtonMotion)) + :pointer-mode xcb:GrabMode:Async + :keyboard-mode xcb:GrabMode:Async + :confine-to xcb:Window:None + :cursor cursor + :time xcb:Time:CurrentTime))))))) + +(defun exwm-floating--stop-moveresize (&rest _args) + "Stop move/resize." + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime)) + (when exwm-floating--moveresize-calculate + (let (result buffer-or-id outer-id container-id) + (setq result (funcall exwm-floating--moveresize-calculate 0 0) + buffer-or-id (aref result 0)) + (when (bufferp buffer-or-id) + (with-current-buffer buffer-or-id + (setq outer-id (frame-parameter exwm--floating-frame 'exwm-outer-id) + container-id (frame-parameter exwm--floating-frame + 'exwm-container)) + (with-slots (x y width height border-width) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container-id)) + ;; Notify Emacs frame about this the position change. + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination outer-id + :event-mask xcb:EventMask:StructureNotify + :event + (xcb:marshal + (make-instance 'xcb:ConfigureNotify + :event outer-id + :window outer-id + :above-sibling xcb:Window:None + :x (+ x border-width) + :y (+ y border-width) + :width width + :height height + :border-width 0 + :override-redirect 0) + exwm--connection))) + (xcb:flush exwm--connection)) + (exwm-layout--show exwm--id + (frame-root-window exwm--floating-frame))))) + (setq exwm-floating--moveresize-calculate nil))) + +(defun exwm-floating--do-moveresize (data _synthetic) + "Perform move/resize." + (when exwm-floating--moveresize-calculate + (let* ((obj (make-instance 'xcb:MotionNotify)) + result value-mask x y width height buffer-or-id container-or-id) + (xcb:unmarshal obj data) + (setq result (funcall exwm-floating--moveresize-calculate + (slot-value obj 'root-x) (slot-value obj 'root-y)) + buffer-or-id (aref result 0) + value-mask (aref result 1) + x (aref result 2) + y (aref result 3) + width (max 1 (aref result 4)) + height (max 1 (aref result 5))) + (if (not (bufferp buffer-or-id)) + ;; Unmanaged. + (setq container-or-id buffer-or-id) + ;; Managed. + (setq container-or-id + (with-current-buffer buffer-or-id + (frame-parameter exwm--floating-frame 'exwm-container)) + x (- x exwm-floating-border-width) + ;; Use `frame-outer-height' in the future. + y (- y exwm-floating-border-width + exwm-workspace--window-y-offset) + height (+ height exwm-workspace--window-y-offset))) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window container-or-id + :value-mask (aref result 1) + :x x + :y y + :width width + :height height)) + (when (bufferp buffer-or-id) + ;; Managed. + (setq value-mask (logand value-mask (logior xcb:ConfigWindow:Width + xcb:ConfigWindow:Height))) + (when (/= 0 value-mask) + (with-current-buffer buffer-or-id + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-outer-id) + :value-mask value-mask + :width width + :height height))))) + (xcb:flush exwm--connection)))) + +(defun exwm-floating-move (&optional delta-x delta-y) + "Move a floating window right by DELTA-X pixels and down by DELTA-Y pixels. + +Both DELTA-X and DELTA-Y default to 1. This command should be bound locally." + (exwm--log "delta-x: %s, delta-y: %s" delta-x delta-y) + (unless (and (derived-mode-p 'exwm-mode) exwm--floating-frame) + (user-error "[EXWM] `exwm-floating-move' is only for floating X windows")) + (unless delta-x (setq delta-x 1)) + (unless delta-y (setq delta-y 1)) + (unless (and (= 0 delta-x) (= 0 delta-y)) + (let* ((floating-container (frame-parameter exwm--floating-frame + 'exwm-container)) + (geometry (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable floating-container))) + (edges (window-inside-absolute-pixel-edges))) + (with-slots (x y) geometry + (exwm--set-geometry floating-container + (+ x delta-x) (+ y delta-y) nil nil)) + (exwm--set-geometry exwm--id + (+ (pop edges) delta-x) + (+ (pop edges) delta-y) + nil nil)) + (xcb:flush exwm--connection))) + +(defun exwm-floating--init () + "Initialize floating module." + (exwm--log) + ;; Initialize cursors for moving/resizing a window + (xcb:cursor:init exwm--connection) + (setq exwm-floating--cursor-move + (xcb:cursor:load-cursor exwm--connection "fleur") + exwm-floating--cursor-top-left + (xcb:cursor:load-cursor exwm--connection "top_left_corner") + exwm-floating--cursor-top + (xcb:cursor:load-cursor exwm--connection "top_side") + exwm-floating--cursor-top-right + (xcb:cursor:load-cursor exwm--connection "top_right_corner") + exwm-floating--cursor-right + (xcb:cursor:load-cursor exwm--connection "right_side") + exwm-floating--cursor-bottom-right + (xcb:cursor:load-cursor exwm--connection "bottom_right_corner") + exwm-floating--cursor-bottom + (xcb:cursor:load-cursor exwm--connection "bottom_side") + exwm-floating--cursor-bottom-left + (xcb:cursor:load-cursor exwm--connection "bottom_left_corner") + exwm-floating--cursor-left + (xcb:cursor:load-cursor exwm--connection "left_side"))) + +(defun exwm-floating--exit () + "Exit the floating module." + (exwm--log)) + + + +(provide 'exwm-floating) + +;;; exwm-floating.el ends here diff --git a/third_party/exwm/exwm-input.el b/third_party/exwm/exwm-input.el new file mode 100644 index 000000000000..f1f035c91ad9 --- /dev/null +++ b/third_party/exwm/exwm-input.el @@ -0,0 +1,1248 @@ +;;; exwm-input.el --- Input Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module deals with key/mouse matters, including: +;; + Input focus, +;; + Key/Button event handling, +;; + Key events filtering and simulation. + +;; Todo: +;; + Pointer simulation mode (e.g. 'C-c 1'/'C-c 2' for single/double click, +;; move with arrow keys). +;; + Simulation keys to mimic Emacs key bindings for text edit (redo, select, +;; cancel, clear, etc). Some of them are not present on common keyboard +;; (keycode = 0). May need to use XKB extension. + +;;; Code: + +(require 'xcb-keysyms) +(require 'exwm-core) + +(defgroup exwm-input nil + "Input." + :group 'exwm) + +(defcustom exwm-input-prefix-keys + '(?\C-x ?\C-u ?\C-h ?\M-x ?\M-` ?\M-& ?\M-:) + "List of prefix keys EXWM should forward to Emacs when in `line-mode'. + +The point is to make keys like 'C-x C-f' forwarded to Emacs in `line-mode'. +There is no need to add prefix keys for global/simulation keys or those +defined in `exwm-mode-map' here." + :type '(repeat key-sequence) + :get (lambda (symbol) + (mapcar #'vector (default-value symbol))) + :set (lambda (symbol value) + (set symbol (mapcar (lambda (i) + (if (sequencep i) + (aref i 0) + i)) + value)))) + +(defcustom exwm-input-move-event 's-down-mouse-1 + "Emacs event to start moving a window." + :type 'key-sequence + :get (lambda (symbol) + (let ((value (default-value symbol))) + (if (mouse-event-p value) + value + (vector value)))) + :set (lambda (symbol value) + (set symbol (if (sequencep value) + (aref value 0) + value)))) + +(defcustom exwm-input-resize-event 's-down-mouse-3 + "Emacs event to start resizing a window." + :type 'key-sequence + :get (lambda (symbol) + (let ((value (default-value symbol))) + (if (mouse-event-p value) + value + (vector value)))) + :set (lambda (symbol value) + (set symbol (if (sequencep value) + (aref value 0) + value)))) + +(defcustom exwm-input-line-mode-passthrough nil + "Non-nil makes `line-mode' forward all events to Emacs." + :type 'boolean) + +;; Input focus update requests should be accumulated for a short time +;; interval so that only the last one need to be processed. This not +;; improves the overall performance, but avoids the problem of input +;; focus loop, which is a result of the interaction with Emacs frames. +;; +;; FIXME: The time interval is hard to decide and perhaps machine-dependent. +;; A value too small can cause redundant updates of input focus, +;; and even worse, dead loops. OTOH a large value would bring +;; laggy experience. +(defconst exwm-input--update-focus-interval 0.01 + "Time interval (in seconds) for accumulating input focus update requests.") + +(defconst exwm-input--passthrough-functions '(read-char + read-char-exclusive + read-key-sequence-vector + read-key-sequence + read-event) + "Low-level read functions that must be exempted from EXWM input handling.") + +(defvar exwm-input--during-command nil + "Indicate whether between `pre-command-hook' and `post-command-hook'.") + +(defvar exwm-input--global-keys nil "Global key bindings.") + +(defvar exwm-input--global-prefix-keys nil + "List of prefix keys of global key bindings.") + +(defvar exwm-input--line-mode-cache nil "Cache for incomplete key sequence.") + +(defvar exwm-input--local-simulation-keys nil + "Whether simulation keys are local.") + +(defvar exwm-input--simulation-keys nil "Simulation keys in `line-mode'.") + +(defvar exwm-input--skip-buffer-list-update nil + "Skip the upcoming `buffer-list-update'.") + +(defvar exwm-input--temp-line-mode nil + "Non-nil indicates it's in temporary line-mode for `char-mode'.") + +(defvar exwm-input--timestamp-atom nil) + +(defvar exwm-input--timestamp-callback nil) + +(defvar exwm-input--timestamp-window nil) + +(defvar exwm-input--update-focus-timer nil + "Timer for deferring the update of input focus.") + +(defvar exwm-input--update-focus-lock nil + "Lock for solving input focus update contention.") + +(defvar exwm-input--update-focus-window nil "The (Emacs) window to be focused. +This value should always be overwritten.") + +(defvar exwm-input--echo-area-timer nil "Timer for detecting echo area dirty.") + +(defvar exwm-input--event-hook nil + "Hook to run when EXWM receives an event.") + +(defvar exwm-input-input-mode-change-hook nil + "Hook to run when an input mode changes on an `exwm-mode' buffer. +Current buffer will be the `exwm-mode' buffer when this hook runs.") + +(defvar exwm-workspace--current) +(declare-function exwm-floating--do-moveresize "exwm-floating.el" + (data _synthetic)) +(declare-function exwm-floating--start-moveresize "exwm-floating.el" + (id &optional type)) +(declare-function exwm-floating--stop-moveresize "exwm-floating.el" + (&rest _args)) +(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) +(declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) +(declare-function exwm-reset "exwm.el" ()) +(declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") +(declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) +(declare-function exwm-workspace-switch "exwm-workspace.el" + (frame-or-index &optional force)) + +(defun exwm-input--set-focus (id) + "Set input focus to window ID in a proper way." + (let ((from (slot-value (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetInputFocus)) + 'focus)) + tree) + (if (or (exwm--id->buffer from) + (eq from id)) + (exwm--log "#x%x => #x%x" (or from 0) (or id 0)) + ;; Attempt to find the top-level X window for a 'focus proxy'. + (unless (= from xcb:Window:None) + (setq tree (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryTree + :window from))) + (when tree + (setq from (slot-value tree 'parent)))) + (exwm--log "#x%x (corrected) => #x%x" (or from 0) (or id 0))) + (when (and (exwm--id->buffer id) + ;; Avoid redundant input focus transfer. + (not (eq from id))) + (with-current-buffer (exwm--id->buffer id) + (exwm-input--update-timestamp + (lambda (timestamp id send-input-focus wm-take-focus) + (when send-input-focus + (xcb:+request exwm--connection + (make-instance 'xcb:SetInputFocus + :revert-to xcb:InputFocus:Parent + :focus id + :time timestamp))) + (when wm-take-focus + (let ((event (make-instance 'xcb:icccm:WM_TAKE_FOCUS + :window id + :time timestamp))) + (setq event (xcb:marshal event exwm--connection)) + (xcb:+request exwm--connection + (make-instance 'xcb:icccm:SendEvent + :destination id + :event event)))) + (exwm-input--set-active-window id) + (xcb:flush exwm--connection)) + id + (or exwm--hints-input + (not (memq xcb:Atom:WM_TAKE_FOCUS exwm--protocols))) + (memq xcb:Atom:WM_TAKE_FOCUS exwm--protocols)))))) + +(defun exwm-input--update-timestamp (callback &rest args) + "Fetch the latest timestamp from the server and feed it to CALLBACK. + +ARGS are additional arguments to CALLBACK." + (setq exwm-input--timestamp-callback (cons callback args)) + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Replace + :window exwm-input--timestamp-window + :property exwm-input--timestamp-atom + :type xcb:Atom:CARDINAL + :format 32 + :data-len 0 + :data nil)) + (xcb:flush exwm--connection)) + +(defun exwm-input--on-PropertyNotify (data _synthetic) + "Handle PropertyNotify events." + (exwm--log) + (when exwm-input--timestamp-callback + (let ((obj (make-instance 'xcb:PropertyNotify))) + (xcb:unmarshal obj data) + (when (= exwm-input--timestamp-window + (slot-value obj 'window)) + (apply (car exwm-input--timestamp-callback) + (slot-value obj 'time) + (cdr exwm-input--timestamp-callback)) + (setq exwm-input--timestamp-callback nil))))) + +(defvar exwm-input--last-enter-notify-position nil) + +(defun exwm-input--on-EnterNotify (data _synthetic) + "Handle EnterNotify events." + (let ((evt (make-instance 'xcb:EnterNotify)) + buffer window frame frame-xid edges fake-evt) + (xcb:unmarshal evt data) + (with-slots (time root event root-x root-y event-x event-y state) evt + (setq buffer (exwm--id->buffer event) + window (get-buffer-window buffer t)) + (exwm--log "buffer=%s; window=%s" buffer window) + (when (and buffer window (not (eq window (selected-window))) + (not (equal exwm-input--last-enter-notify-position + (vector root-x root-y)))) + (setq frame (window-frame window) + frame-xid (frame-parameter frame 'exwm-id)) + (unless (eq frame exwm-workspace--current) + (if (exwm-workspace--workspace-p frame) + ;; The X window is on another workspace. + (exwm-workspace-switch frame) + (with-current-buffer buffer + (when (and (derived-mode-p 'exwm-mode) + (not (eq exwm--frame exwm-workspace--current))) + ;; The floating X window is on another workspace. + (exwm-workspace-switch exwm--frame))))) + ;; Send a fake MotionNotify event to Emacs. + (setq edges (window-inside-pixel-edges window) + fake-evt (make-instance 'xcb:MotionNotify + :detail 0 + :time time + :root root + :event frame-xid + :child xcb:Window:None + :root-x root-x + :root-y root-y + :event-x (+ event-x (elt edges 0)) + :event-y (+ event-y (elt edges 1)) + :state state + :same-screen 1)) + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination frame-xid + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal fake-evt exwm--connection))) + (xcb:flush exwm--connection)) + (setq exwm-input--last-enter-notify-position (vector root-x root-y))))) + +(defun exwm-input--on-keysyms-update () + (exwm--log) + (let ((exwm-input--global-prefix-keys nil)) + (exwm-input--update-global-prefix-keys))) + +(defun exwm-input--on-buffer-list-update () + "Run in `buffer-list-update-hook' to track input focus." + (when (and ; this hook is called incesantly; place cheap tests on top + (not exwm-input--skip-buffer-list-update) + (exwm--terminal-p) ; skip other terminals, e.g. TTY client frames + (not (frame-parameter nil 'no-accept-focus))) + (exwm--log "current-buffer=%S selected-window=%S" + (current-buffer) (selected-window)) + (redirect-frame-focus (selected-frame) nil) + (setq exwm-input--update-focus-window (selected-window)) + (exwm-input--update-focus-defer))) + +(defun exwm-input--update-focus-defer () + "Schedule a deferred update to input focus. +Instead of immediately focusing the current window, it defers the focus change +until the selected window stops changing (debouncing input focus updates)." + (when exwm-input--update-focus-timer + (cancel-timer exwm-input--update-focus-timer)) + (setq exwm-input--update-focus-timer + ;; Attempt to accumulate successive events close enough. + (run-with-timer exwm-input--update-focus-interval + nil + #'exwm-input--update-focus-commit))) + +(defun exwm-input--update-focus-commit () + "Attempt to update the window focus. +If we're currently updating the window focus, re-schedule a focus update +attempt later." + (if exwm-input--update-focus-lock + (exwm-input--update-focus-defer) + (let ((exwm-input--update-focus-lock t)) + (exwm-input--update-focus exwm-input--update-focus-window)))) + +(defun exwm-input--update-focus (window) + "Update input focus to WINDOW." + (when (window-live-p window) + (exwm--log "focus-window=%s focus-buffer=%s" window (window-buffer window)) + (with-current-buffer (window-buffer window) + (if (derived-mode-p 'exwm-mode) + (if (not (eq exwm--frame exwm-workspace--current)) + (progn + (set-frame-parameter exwm--frame 'exwm-selected-window window) + (exwm--defer 0 #'exwm-workspace-switch exwm--frame)) + (exwm--log "Set focus on #x%x" exwm--id) + (when exwm--floating-frame + ;; Adjust stacking orders of the floating X window. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window exwm--id + :value-mask xcb:ConfigWindow:StackMode + :stack-mode xcb:StackMode:TopIf)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-container) + :value-mask (logior + xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--id + :stack-mode xcb:StackMode:Below)) + ;; This floating X window might be hide by `exwm-floating-hide'. + (when (exwm-layout--iconic-state-p) + (exwm-layout--show exwm--id window)) + (xcb:flush exwm--connection)) + (exwm-input--set-focus exwm--id)) + (when (eq (selected-window) window) + (exwm--log "Focus on %s" window) + (if (and (exwm-workspace--workspace-p (selected-frame)) + (not (eq (selected-frame) exwm-workspace--current))) + ;; The focus is on another workspace (e.g. it got clicked) + ;; so switch to it. + (progn + (exwm--log "Switching to %s's workspace %s (%s)" + window + (window-frame window) + (selected-frame)) + (set-frame-parameter (selected-frame) 'exwm-selected-window + window) + (exwm--defer 0 #'exwm-workspace-switch (selected-frame))) + ;; The focus is still on the current workspace. + (if (not (and (exwm-workspace--minibuffer-own-frame-p) + (minibufferp))) + (x-focus-frame (window-frame window)) + ;; X input focus should be set on the previously selected + ;; frame. + (x-focus-frame (window-frame (minibuffer-window)))) + (exwm-input--set-active-window) + (xcb:flush exwm--connection))))))) + +(defun exwm-input--set-active-window (&optional id) + "Set _NET_ACTIVE_WINDOW." + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_ACTIVE_WINDOW + :window exwm--root + :data (or id xcb:Window:None)))) + +(defun exwm-input--on-ButtonPress (data _synthetic) + "Handle ButtonPress event." + (let ((obj (make-instance 'xcb:ButtonPress)) + (mode xcb:Allow:SyncPointer) + button-event window buffer frame fake-last-command) + (xcb:unmarshal obj data) + (exwm--log "major-mode=%s buffer=%s" + major-mode (buffer-name (current-buffer))) + (with-slots (detail event state) obj + (setq button-event (xcb:keysyms:keysym->event exwm--connection + detail state) + buffer (exwm--id->buffer event) + window (get-buffer-window buffer t)) + (cond ((and (eq button-event exwm-input-move-event) + buffer + ;; Either an undecorated or a floating X window. + (with-current-buffer buffer + (or (not (derived-mode-p 'exwm-mode)) + exwm--floating-frame))) + ;; Move + (exwm-floating--start-moveresize + event xcb:ewmh:_NET_WM_MOVERESIZE_MOVE)) + ((and (eq button-event exwm-input-resize-event) + buffer + (with-current-buffer buffer + (or (not (derived-mode-p 'exwm-mode)) + exwm--floating-frame))) + ;; Resize + (exwm-floating--start-moveresize event)) + (buffer + ;; Click to focus + (setq fake-last-command t) + (unless (eq window (selected-window)) + (setq frame (window-frame window)) + (unless (eq frame exwm-workspace--current) + (if (exwm-workspace--workspace-p frame) + ;; The X window is on another workspace + (exwm-workspace-switch frame) + (with-current-buffer buffer + (when (and (derived-mode-p 'exwm-mode) + (not (eq exwm--frame + exwm-workspace--current))) + ;; The floating X window is on another workspace + (exwm-workspace-switch exwm--frame))))) + ;; It has been reported that the `window' may have be deleted + (if (window-live-p window) + (select-window window) + (setq window (get-buffer-window buffer t)) + (when window (select-window window)))) + ;; Also process keybindings. + (with-current-buffer buffer + (when (derived-mode-p 'exwm-mode) + (cl-case exwm--input-mode + (line-mode + (setq mode (exwm-input--on-ButtonPress-line-mode + buffer button-event))) + (char-mode + (setq mode (exwm-input--on-ButtonPress-char-mode))))))) + (t + ;; Replay this event by default. + (setq fake-last-command t) + (setq mode xcb:Allow:ReplayPointer))) + (when fake-last-command + (if buffer + (with-current-buffer buffer + (exwm-input--fake-last-command)) + (exwm-input--fake-last-command)))) + (xcb:+request exwm--connection + (make-instance 'xcb:AllowEvents :mode mode :time xcb:Time:CurrentTime)) + (xcb:flush exwm--connection)) + (run-hooks 'exwm-input--event-hook)) + +(defun exwm-input--on-KeyPress (data _synthetic) + "Handle KeyPress event." + (with-current-buffer (window-buffer (selected-window)) + (let ((obj (make-instance 'xcb:KeyPress))) + (xcb:unmarshal obj data) + (exwm--log "major-mode=%s buffer=%s" + major-mode (buffer-name (current-buffer))) + (if (derived-mode-p 'exwm-mode) + (cl-case exwm--input-mode + (line-mode + (exwm-input--on-KeyPress-line-mode obj data)) + (char-mode + (exwm-input--on-KeyPress-char-mode obj data))) + (exwm-input--on-KeyPress-char-mode obj))) + (run-hooks 'exwm-input--event-hook))) + +(defun exwm-input--on-CreateNotify (data _synthetic) + "Handle CreateNotify events." + (exwm--log) + (let ((evt (make-instance 'xcb:CreateNotify))) + (xcb:unmarshal evt data) + (with-slots (window) evt + (exwm-input--grab-global-prefix-keys window)))) + +(defun exwm-input--update-global-prefix-keys () + "Update `exwm-input--global-prefix-keys'." + (exwm--log) + (when exwm--connection + (let ((original exwm-input--global-prefix-keys)) + (setq exwm-input--global-prefix-keys nil) + (dolist (i exwm-input--global-keys) + (cl-pushnew (elt i 0) exwm-input--global-prefix-keys)) + (unless (equal original exwm-input--global-prefix-keys) + (apply #'exwm-input--grab-global-prefix-keys + (slot-value (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryTree + :window exwm--root)) + 'children)))))) + +(defun exwm-input--grab-global-prefix-keys (&rest xwins) + (exwm--log) + (let ((req (make-instance 'xcb:GrabKey + :owner-events 0 + :grab-window nil + :modifiers nil + :key nil + :pointer-mode xcb:GrabMode:Async + :keyboard-mode xcb:GrabMode:Async)) + keysyms keycode alt-modifier) + (dolist (k exwm-input--global-prefix-keys) + (setq keysyms (xcb:keysyms:event->keysyms exwm--connection k)) + (if (not keysyms) + (warn "Key unavailable: %s" (key-description (vector k))) + (setq keycode (xcb:keysyms:keysym->keycode exwm--connection + (caar keysyms))) + (exwm--log "Grabbing key=%s (keysyms=%s keycode=%s)" + (single-key-description k) keysyms keycode) + (dolist (keysym keysyms) + (setf (slot-value req 'modifiers) (cdr keysym) + (slot-value req 'key) keycode) + ;; Also grab this key with num-lock mask set. + (when (and (/= 0 xcb:keysyms:num-lock-mask) + (= 0 (logand (cdr keysym) xcb:keysyms:num-lock-mask))) + (setf alt-modifier (logior (cdr keysym) + xcb:keysyms:num-lock-mask))) + (dolist (xwin xwins) + (setf (slot-value req 'grab-window) xwin) + (xcb:+request exwm--connection req) + (when alt-modifier + (setf (slot-value req 'modifiers) alt-modifier) + (xcb:+request exwm--connection req)))))) + (xcb:flush exwm--connection))) + +(defun exwm-input--set-key (key command) + (exwm--log "key: %s, command: %s" key command) + (global-set-key key command) + (cl-pushnew key exwm-input--global-keys)) + +(defcustom exwm-input-global-keys nil + "Global keys. + +It is an alist of the form (key . command), meaning giving KEY (a key +sequence) a global binding as COMMAND. + +Notes: +* Setting the value directly (rather than customizing it) after EXWM + finishes initialization has no effect." + :type '(alist :key-type key-sequence :value-type function) + :set (lambda (symbol value) + (when (boundp symbol) + (dolist (i (symbol-value symbol)) + (global-unset-key (car i)))) + (set symbol value) + (setq exwm-input--global-keys nil) + (dolist (i value) + (exwm-input--set-key (car i) (cdr i))) + (when exwm--connection + (exwm-input--update-global-prefix-keys)))) + +;;;###autoload +(defun exwm-input-set-key (key command) + "Set a global key binding. + +The new key binding only takes effect in real time when this command is +called interactively, and is lost when this session ends unless it's +specifically saved in the Customize interface for `exwm-input-global-keys'. + +In configuration you should customize or set `exwm-input-global-keys' +instead." + (interactive "KSet key globally: \nCSet key %s to command: ") + (exwm--log) + (setq exwm-input-global-keys (append exwm-input-global-keys + (list (cons key command)))) + (exwm-input--set-key key command) + (when (called-interactively-p 'any) + (exwm-input--update-global-prefix-keys))) + +(defsubst exwm-input--unread-event (event) + (declare (indent defun)) + (setq unread-command-events + (append unread-command-events `((t . ,event))))) + +(defun exwm-input--mimic-read-event (event) + "Process EVENT as if it were returned by `read-event'." + (exwm--log) + (unless (eq 0 extra-keyboard-modifiers) + (setq event (event-convert-list (append (event-modifiers + extra-keyboard-modifiers) + event)))) + (when (characterp event) + (let ((event* (when keyboard-translate-table + (aref keyboard-translate-table event)))) + (when event* + (setq event event*)))) + event) + +(cl-defun exwm-input--translate (key) + (let (translation) + (dolist (map (list input-decode-map + local-function-key-map + key-translation-map)) + (setq translation (lookup-key map key)) + (if (functionp translation) + (cl-return-from exwm-input--translate (funcall translation nil)) + (when (vectorp translation) + (cl-return-from exwm-input--translate translation))))) + key) + +(defun exwm-input--cache-event (event &optional temp-line-mode) + "Cache EVENT." + (exwm--log "%s" event) + (setq exwm-input--line-mode-cache + (vconcat exwm-input--line-mode-cache (vector event))) + ;; Attempt to translate this key sequence. + (setq exwm-input--line-mode-cache + (exwm-input--translate exwm-input--line-mode-cache)) + ;; When the key sequence is complete (not a keymap). + ;; Note that `exwm-input--line-mode-cache' might get translated to nil, for + ;; example 'mouse--down-1-maybe-follows-link' does this. + (if (and exwm-input--line-mode-cache + (keymapp (key-binding exwm-input--line-mode-cache))) + ;; Grab keyboard temporarily to intercept the complete key sequence. + (when temp-line-mode + (setq exwm-input--temp-line-mode t) + (exwm-input--grab-keyboard)) + (setq exwm-input--line-mode-cache nil) + (when exwm-input--temp-line-mode + (setq exwm-input--temp-line-mode nil) + (exwm-input--release-keyboard)))) + +(defun exwm-input--event-passthrough-p (event) + "Whether EVENT should be passed to Emacs. +Current buffer must be an `exwm-mode' buffer." + (or exwm-input-line-mode-passthrough + exwm-input--during-command + ;; Forward the event when there is an incomplete key + ;; sequence or when the minibuffer is active. + exwm-input--line-mode-cache + (eq (active-minibuffer-window) (selected-window)) + ;; + (memq event exwm-input--global-prefix-keys) + (memq event exwm-input-prefix-keys) + (when overriding-terminal-local-map + (lookup-key overriding-terminal-local-map + (vector event))) + (lookup-key (current-local-map) (vector event)) + (gethash event exwm-input--simulation-keys))) + +(defun exwm-input--noop (&rest _args) + "A placeholder command." + (interactive)) + +(defun exwm-input--fake-last-command () + "Fool some packages into thinking there is a change in the buffer." + (setq last-command #'exwm-input--noop) + ;; The Emacs manual says: + ;; > Quitting is suppressed while running pre-command-hook and + ;; > post-command-hook. If an error happens while executing one of these + ;; > hooks, it does not terminate execution of the hook; instead the error is + ;; > silenced and the function in which the error occurred is removed from the + ;; > hook. + ;; We supress errors but neither continue execution nor we remove from the + ;; hook. + (condition-case err + (run-hooks 'pre-command-hook) + ((error) + (exwm--log "Error occurred while running pre-command-hook: %s" + (error-message-string err)) + (xcb-debug:backtrace))) + (condition-case err + (run-hooks 'post-command-hook) + ((error) + (exwm--log "Error occurred while running post-command-hook: %s" + (error-message-string err)) + (xcb-debug:backtrace)))) + +(defun exwm-input--on-KeyPress-line-mode (key-press raw-data) + "Parse X KeyPress event to Emacs key event and then feed the command loop." + (with-slots (detail state) key-press + (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) + event raw-event mode) + (exwm--log "%s" keysym) + (when (and (/= 0 (car keysym)) + (setq raw-event (xcb:keysyms:keysym->event + exwm--connection (car keysym) + (logand state (lognot (cdr keysym))))) + (setq event (exwm-input--mimic-read-event raw-event)) + (exwm-input--event-passthrough-p event)) + (setq mode xcb:Allow:AsyncKeyboard) + (exwm-input--cache-event event) + (exwm-input--unread-event raw-event)) + (unless mode + (if (= 0 (logand #x6000 state)) ;Check the 13~14 bits. + ;; Not an XKB state; just replay it. + (setq mode xcb:Allow:ReplayKeyboard) + ;; An XKB state; sent it with SendEvent. + ;; FIXME: Can this also be replayed? + ;; FIXME: KeyRelease events are lost. + (setq mode xcb:Allow:AsyncKeyboard) + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination (slot-value key-press 'event) + :event-mask xcb:EventMask:NoEvent + :event raw-data))) + (when event + (if (not defining-kbd-macro) + (exwm-input--fake-last-command) + ;; Make Emacs aware of this event when defining keyboard macros. + (set-transient-map `(keymap (t . ,#'exwm-input--noop))) + (exwm-input--unread-event event)))) + (xcb:+request exwm--connection + (make-instance 'xcb:AllowEvents + :mode mode + :time xcb:Time:CurrentTime)) + (xcb:flush exwm--connection)))) + +(defun exwm-input--on-KeyPress-char-mode (key-press &optional _raw-data) + "Handle KeyPress event in `char-mode'." + (with-slots (detail state) key-press + (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) + event raw-event) + (exwm--log "%s" keysym) + (when (and (/= 0 (car keysym)) + (setq raw-event (xcb:keysyms:keysym->event + exwm--connection (car keysym) + (logand state (lognot (cdr keysym))))) + (setq event (exwm-input--mimic-read-event raw-event))) + (if (not (derived-mode-p 'exwm-mode)) + (exwm-input--unread-event raw-event) + (exwm-input--cache-event event t) + (exwm-input--unread-event raw-event))))) + (xcb:+request exwm--connection + (make-instance 'xcb:AllowEvents + :mode xcb:Allow:AsyncKeyboard + :time xcb:Time:CurrentTime)) + (xcb:flush exwm--connection)) + +(defun exwm-input--on-ButtonPress-line-mode (buffer button-event) + "Handle button events in line mode. +BUFFER is the `exwm-mode' buffer the event was generated +on. BUTTON-EVENT is the X event converted into an Emacs event. + +The return value is used as event_mode to release the original +button event." + (with-current-buffer buffer + (let ((read-event (exwm-input--mimic-read-event button-event))) + (exwm--log "%s" read-event) + (if (and read-event + (exwm-input--event-passthrough-p read-event)) + ;; The event should be forwarded to emacs + (progn + (exwm-input--cache-event read-event) + (exwm-input--unread-event button-event) + xcb:Allow:SyncPointer) + ;; The event should be replayed + xcb:Allow:ReplayPointer)))) + +(defun exwm-input--on-ButtonPress-char-mode () + "Handle button events in `char-mode'. +The return value is used as event_mode to release the original +button event." + (exwm--log) + xcb:Allow:ReplayPointer) + +(defun exwm-input--update-mode-line (id) + "Update the propertized `mode-line-process' for window ID." + (exwm--log "#x%x" id) + (let (help-echo cmd mode) + (with-current-buffer (exwm--id->buffer id) + (cl-case exwm--input-mode + (line-mode + (setq mode "line" + help-echo "mouse-1: Switch to char-mode" + cmd (lambda () + (interactive) + (exwm-input-release-keyboard id)))) + (char-mode + (setq mode "char" + help-echo "mouse-1: Switch to line-mode" + cmd (lambda () + (interactive) + (exwm-input-grab-keyboard id))))) + (setq mode-line-process + `(": " + (:propertize ,mode + help-echo ,help-echo + mouse-face mode-line-highlight + local-map + (keymap + (mode-line + keymap + (down-mouse-1 . ,cmd)))))) + (force-mode-line-update)))) + +(defun exwm-input--grab-keyboard (&optional id) + "Grab all key events on window ID." + (unless id (setq id (exwm--buffer->id (window-buffer)))) + (when id + (exwm--log "id=#x%x" id) + (when (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:GrabKey + :owner-events 0 + :grab-window id + :modifiers xcb:ModMask:Any + :key xcb:Grab:Any + :pointer-mode xcb:GrabMode:Async + :keyboard-mode xcb:GrabMode:Sync)) + (exwm--log "Failed to grab keyboard for #x%x" id)) + (let ((buffer (exwm--id->buffer id))) + (when buffer + (with-current-buffer buffer + (setq exwm--input-mode 'line-mode) + (run-hooks 'exwm-input-input-mode-change-hook)))))) + +(defun exwm-input--release-keyboard (&optional id) + "Ungrab all key events on window ID." + (unless id (setq id (exwm--buffer->id (window-buffer)))) + (when id + (exwm--log "id=#x%x" id) + (when (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:UngrabKey + :key xcb:Grab:Any + :grab-window id + :modifiers xcb:ModMask:Any)) + (exwm--log "Failed to release keyboard for #x%x" id)) + (exwm-input--grab-global-prefix-keys id) + (let ((buffer (exwm--id->buffer id))) + (when buffer + (with-current-buffer buffer + (setq exwm--input-mode 'char-mode) + (run-hooks 'exwm-input-input-mode-change-hook)))))) + +;;;###autoload +(defun exwm-input-grab-keyboard (&optional id) + "Switch to `line-mode'." + (interactive (list (when (derived-mode-p 'exwm-mode) + (exwm--buffer->id (window-buffer))))) + (when id + (exwm--log "id=#x%x" id) + (setq exwm--selected-input-mode 'line-mode) + (exwm-input--grab-keyboard id) + (exwm-input--update-mode-line id))) + +;;;###autoload +(defun exwm-input-release-keyboard (&optional id) + "Switch to `char-mode`." + (interactive (list (when (derived-mode-p 'exwm-mode) + (exwm--buffer->id (window-buffer))))) + (when id + (exwm--log "id=#x%x" id) + (setq exwm--selected-input-mode 'char-mode) + (exwm-input--release-keyboard id) + (exwm-input--update-mode-line id))) + +;;;###autoload +(defun exwm-input-toggle-keyboard (&optional id) + "Toggle between `line-mode' and `char-mode'." + (interactive (list (when (derived-mode-p 'exwm-mode) + (exwm--buffer->id (window-buffer))))) + (when id + (exwm--log "id=#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (cl-case exwm--input-mode + (line-mode + (exwm-input-release-keyboard id)) + (char-mode + (exwm-reset)))))) + +(defun exwm-input--fake-key (event) + "Fake a key event equivalent to Emacs event EVENT." + (let* ((keysyms (xcb:keysyms:event->keysyms exwm--connection event)) + keycode id) + (when (= 0 (caar keysyms)) + (user-error "[EXWM] Invalid key: %s" (single-key-description event))) + (setq keycode (xcb:keysyms:keysym->keycode exwm--connection + (caar keysyms))) + (when (/= 0 keycode) + (setq id (exwm--buffer->id (window-buffer (selected-window)))) + (exwm--log "id=#x%x event=%s keycode" id event keycode) + (dolist (class '(xcb:KeyPress xcb:KeyRelease)) + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 :destination id + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal + (make-instance class + :detail keycode + :time xcb:Time:CurrentTime + :root exwm--root :event id + :child 0 + :root-x 0 :root-y 0 + :event-x 0 :event-y 0 + :state (cdar keysyms) + :same-screen 1) + exwm--connection))))) + (xcb:flush exwm--connection))) + +;;;###autoload +(cl-defun exwm-input-send-next-key (times &optional end-key) + "Send next key to client window. + +EXWM will prompt for the key to send. This command can be prefixed to send +multiple keys. If END-KEY is non-nil, stop sending keys if it's pressed." + (interactive "p") + (exwm--log) + (unless (derived-mode-p 'exwm-mode) + (cl-return-from exwm-input-send-next-key)) + (when (> times 12) (setq times 12)) + (let (key keys) + (dotimes (i times) + ;; Skip events not from keyboard + (let ((exwm-input-line-mode-passthrough t)) + (catch 'break + (while t + (setq key (read-key (format "Send key: %s (%d/%d) %s" + (key-description keys) + (1+ i) times + (if end-key + (concat "To exit, press: " + (key-description + (list end-key))) + "")))) + (unless (listp key) (throw 'break nil))))) + (setq keys (vconcat keys (vector key))) + (when (eq key end-key) (cl-return-from exwm-input-send-next-key)) + (exwm-input--fake-key key)))) + +(defun exwm-input--set-simulation-keys (simulation-keys &optional no-refresh) + "Set simulation keys." + (exwm--log "%s" simulation-keys) + (unless no-refresh + ;; Unbind simulation keys. + (let ((hash (buffer-local-value 'exwm-input--simulation-keys + (current-buffer)))) + (when (hash-table-p hash) + (maphash (lambda (key _value) + (when (sequencep key) + (if exwm-input--local-simulation-keys + (local-unset-key key) + (define-key exwm-mode-map key nil)))) + hash))) + ;; Abandon the old hash table. + (setq exwm-input--simulation-keys (make-hash-table :test #'equal))) + (dolist (i simulation-keys) + (let ((original (vconcat (car i))) + (simulated (cdr i))) + (setq simulated (if (sequencep simulated) + (append simulated nil) + (list simulated))) + ;; The key stored is a key sequence (vector). + ;; The value stored is a list of key events. + (puthash original simulated exwm-input--simulation-keys) + ;; Also mark the prefix key as used. + (puthash (aref original 0) t exwm-input--simulation-keys))) + ;; Update keymaps. + (maphash (lambda (key _value) + (when (sequencep key) + (if exwm-input--local-simulation-keys + (local-set-key key #'exwm-input-send-simulation-key) + (define-key exwm-mode-map key + #'exwm-input-send-simulation-key)))) + exwm-input--simulation-keys)) + +(defcustom exwm-input-simulation-keys nil + "Simulation keys. + +It is an alist of the form (original-key . simulated-key), where both +original-key and simulated-key are key sequences. Original-key is what you +type to an X window in `line-mode' which then gets translated to simulated-key +by EXWM and forwarded to the X window. + +Notes: +* Setting the value directly (rather than customizing it) after EXWM + finishes initialization has no effect. +* Original-keys consist of multiple key events are only supported in Emacs + 26.2 and later. +* A minority of applications do not accept simulated keys by default. It's + required to customize them to accept events sent by SendEvent. +* The predefined examples in the Customize interface are not guaranteed to + work for all applications. This can be tweaked on a per application basis + with `exwm-input-set-local-simulation-keys'." + :type '(alist :key-type (key-sequence :tag "Original") + :value-type (choice (key-sequence :tag "User-defined") + (key-sequence :tag "Move left" [left]) + (key-sequence :tag "Move right" [right]) + (key-sequence :tag "Move up" [up]) + (key-sequence :tag "Move down" [down]) + (key-sequence :tag "Move to BOL" [home]) + (key-sequence :tag "Move to EOL" [end]) + (key-sequence :tag "Page up" [prior]) + (key-sequence :tag "Page down" [next]) + (key-sequence :tag "Copy" [C-c]) + (key-sequence :tag "Paste" [C-v]) + (key-sequence :tag "Delete" [delete]) + (key-sequence :tag "Delete to EOL" + [S-end delete]))) + :set (lambda (symbol value) + (set symbol value) + (exwm-input--set-simulation-keys value))) + +(defcustom exwm-input-pre-post-command-blacklist '(exit-minibuffer + abort-recursive-edit + minibuffer-keyboard-quit) + "Commands impossible to detect with `post-command-hook'." + :type '(repeat function)) + +(cl-defun exwm-input--read-keys (prompt stop-key) + (let ((cursor-in-echo-area t) + keys key) + (while (not (eq key stop-key)) + (setq key (read-key (format "%s (terminate with %s): %s" + prompt + (key-description (vector stop-key)) + (key-description keys))) + keys (vconcat keys (vector key)))) + (when (> (length keys) 1) + (substring keys 0 -1)))) + +;;;###autoload +(defun exwm-input-set-simulation-key (original-key simulated-key) + "Set a simulation key. + +The simulation key takes effect in real time, but is lost when this session +ends unless it's specifically saved in the Customize interface for +`exwm-input-simulation-keys'." + (interactive + (let (original simulated) + (setq original (exwm-input--read-keys "Translate from" ?\C-g)) + (when original + (setq simulated (exwm-input--read-keys + (format "Translate from %s to" + (key-description original)) + ?\C-g))) + (list original simulated))) + (exwm--log "original: %s, simulated: %s" original-key simulated-key) + (when (and original-key simulated-key) + (let ((entry `((,original-key . ,simulated-key)))) + (setq exwm-input-simulation-keys (append exwm-input-simulation-keys + entry)) + (exwm-input--set-simulation-keys entry t)))) + +(defun exwm-input--unset-simulation-keys () + "Clear simulation keys and key bindings defined." + (exwm--log) + (when (hash-table-p exwm-input--simulation-keys) + (maphash (lambda (key _value) + (when (sequencep key) + (define-key exwm-mode-map key nil))) + exwm-input--simulation-keys) + (clrhash exwm-input--simulation-keys))) + +(defun exwm-input-set-local-simulation-keys (simulation-keys) + "Set buffer-local simulation keys. + +SIMULATION-KEYS is an alist of the form (original-key . simulated-key), +where both ORIGINAL-KEY and SIMULATED-KEY are key sequences." + (exwm--log) + (make-local-variable 'exwm-input--simulation-keys) + (use-local-map (copy-keymap exwm-mode-map)) + (let ((exwm-input--local-simulation-keys t)) + (exwm-input--set-simulation-keys simulation-keys))) + +;;;###autoload +(cl-defun exwm-input-send-simulation-key (times) + "Fake a key event according to the last input key sequence." + (interactive "p") + (exwm--log) + (unless (derived-mode-p 'exwm-mode) + (cl-return-from exwm-input-send-simulation-key)) + (let ((keys (gethash (this-single-command-keys) + exwm-input--simulation-keys))) + (dotimes (_ times) + (dolist (key keys) + (exwm-input--fake-key key))))) + +;;;###autoload +(defmacro exwm-input-invoke-factory (keys) + "Make a command that invokes KEYS when called. + +One use is to access the keymap bound to KEYS (as prefix keys) in `char-mode'." + (let* ((keys (kbd keys)) + (description (key-description keys))) + `(defun ,(intern (concat "exwm-input--invoke--" description)) () + ,(format "Invoke `%s'." description) + (interactive) + (mapc (lambda (key) + (exwm-input--cache-event key t) + (exwm-input--unread-event key)) + ',(listify-key-sequence keys))))) + +(defun exwm-input--on-pre-command () + "Run in `pre-command-hook'." + (unless (or (eq this-command #'exwm-input--noop) + (memq this-command exwm-input-pre-post-command-blacklist)) + (setq exwm-input--during-command t))) + +(defun exwm-input--on-post-command () + "Run in `post-command-hook'." + (unless (eq this-command #'exwm-input--noop) + (setq exwm-input--during-command nil))) + +(defun exwm-input--on-minibuffer-setup () + "Run in `minibuffer-setup-hook' to grab keyboard if necessary." + (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook + (selected-window))) ; echo-area-clear-hook + (frame (window-frame window))) + (when (exwm--terminal-p frame) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + (eq exwm--selected-input-mode 'char-mode)) + (exwm--log "Grab #x%x window=%s frame=%s" exwm--id window frame) + (exwm-input--grab-keyboard exwm--id)))))) + +(defun exwm-input--on-minibuffer-exit () + "Run in `minibuffer-exit-hook' to release keyboard if necessary." + (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook + (selected-window))) ; echo-area-clear-hook + (frame (window-frame window))) + (when (exwm--terminal-p frame) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + (eq exwm--selected-input-mode 'char-mode) + (eq exwm--input-mode 'line-mode)) + (exwm--log "Release #x%x window=%s frame=%s" exwm--id window frame) + (exwm-input--release-keyboard exwm--id)))))) + +(defun exwm-input--on-echo-area-dirty () + "Run when new message arrives to grab keyboard if necessary." + (when (and cursor-in-echo-area + (not (active-minibuffer-window))) + (exwm--log) + (exwm-input--on-minibuffer-setup))) + +(defun exwm-input--on-echo-area-clear () + "Run in `echo-area-clear-hook' to release keyboard if necessary." + (unless (current-message) + (exwm--log) + (exwm-input--on-minibuffer-exit))) + +(defun exwm-input--call-with-passthrough (function &rest args) + "Bind `exwm-input-line-mode-passthrough' and call FUNCTION with ARGS." + (let ((exwm-input-line-mode-passthrough t)) + (apply function args))) + +(defun exwm-input--init () + "Initialize the keyboard module." + (exwm--log) + ;; Refresh keyboard mapping + (xcb:keysyms:init exwm--connection #'exwm-input--on-keysyms-update) + ;; Create the X window and intern the atom used to fetch timestamp. + (setq exwm-input--timestamp-window (xcb:generate-id exwm--connection)) + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid exwm-input--timestamp-window + :parent exwm--root + :x -1 + :y -1 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:CopyFromParent + :visual 0 + :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:PropertyChange)) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window exwm-input--timestamp-window + :data "EXWM: exwm-input--timestamp-window")) + (setq exwm-input--timestamp-atom (exwm--intern-atom "_TIME")) + ;; Initialize global keys. + (dolist (i exwm-input-global-keys) + (exwm-input--set-key (car i) (cdr i))) + ;; Initialize simulation keys. + (when exwm-input-simulation-keys + (exwm-input--set-simulation-keys exwm-input-simulation-keys)) + ;; Attach event listeners + (xcb:+event exwm--connection 'xcb:PropertyNotify + #'exwm-input--on-PropertyNotify) + (xcb:+event exwm--connection 'xcb:CreateNotify #'exwm-input--on-CreateNotify) + (xcb:+event exwm--connection 'xcb:KeyPress #'exwm-input--on-KeyPress) + (xcb:+event exwm--connection 'xcb:ButtonPress #'exwm-input--on-ButtonPress) + (xcb:+event exwm--connection 'xcb:ButtonRelease + #'exwm-floating--stop-moveresize) + (xcb:+event exwm--connection 'xcb:MotionNotify + #'exwm-floating--do-moveresize) + (when mouse-autoselect-window + (xcb:+event exwm--connection 'xcb:EnterNotify + #'exwm-input--on-EnterNotify)) + ;; Control `exwm-input--during-command' + (add-hook 'pre-command-hook #'exwm-input--on-pre-command) + (add-hook 'post-command-hook #'exwm-input--on-post-command) + ;; Grab/Release keyboard when minibuffer/echo becomes active/inactive. + (add-hook 'minibuffer-setup-hook #'exwm-input--on-minibuffer-setup) + (add-hook 'minibuffer-exit-hook #'exwm-input--on-minibuffer-exit) + (setq exwm-input--echo-area-timer + (run-with-idle-timer 0 t #'exwm-input--on-echo-area-dirty)) + (add-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) + ;; Update focus when buffer list updates + (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) + + (dolist (fun exwm-input--passthrough-functions) + (advice-add fun :around #'exwm-input--call-with-passthrough))) + +(defun exwm-input--post-init () + "The second stage in the initialization of the input module." + (exwm--log) + (exwm-input--update-global-prefix-keys)) + +(defun exwm-input--exit () + "Exit the input module." + (exwm--log) + (dolist (fun exwm-input--passthrough-functions) + (advice-remove fun #'exwm-input--call-with-passthrough)) + (exwm-input--unset-simulation-keys) + (remove-hook 'pre-command-hook #'exwm-input--on-pre-command) + (remove-hook 'post-command-hook #'exwm-input--on-post-command) + (remove-hook 'minibuffer-setup-hook #'exwm-input--on-minibuffer-setup) + (remove-hook 'minibuffer-exit-hook #'exwm-input--on-minibuffer-exit) + (when exwm-input--echo-area-timer + (cancel-timer exwm-input--echo-area-timer) + (setq exwm-input--echo-area-timer nil)) + (remove-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) + (remove-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) + (when exwm-input--update-focus-timer + (cancel-timer exwm-input--update-focus-timer)) + ;; Make input focus working even without a WM. + (when (slot-value exwm--connection 'connected) + (xcb:+request exwm--connection + (make-instance 'xcb:SetInputFocus + :revert-to xcb:InputFocus:PointerRoot + :focus exwm--root + :time xcb:Time:CurrentTime)) + (xcb:flush exwm--connection))) + + + +(provide 'exwm-input) + +;;; exwm-input.el ends here diff --git a/third_party/exwm/exwm-layout.el b/third_party/exwm/exwm-layout.el new file mode 100644 index 000000000000..8649c11ffd42 --- /dev/null +++ b/third_party/exwm/exwm-layout.el @@ -0,0 +1,631 @@ +;;; exwm-layout.el --- Layout Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module is responsible for keeping X client window properly displayed. + +;;; Code: + +(require 'exwm-core) + +(defgroup exwm-layout nil + "Layout." + :group 'exwm) + +(defcustom exwm-layout-auto-iconify t + "Non-nil to automatically iconify unused X windows when possible." + :type 'boolean) + +(defcustom exwm-layout-show-all-buffers nil + "Non-nil to allow switching to buffers on other workspaces." + :type 'boolean) + +(defconst exwm-layout--floating-hidden-position -101 + "Where to place hidden floating X windows.") + +(defvar exwm-layout--other-buffer-exclude-buffers nil + "List of buffers that should not be selected by `other-buffer'.") + +(defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil + "When non-nil, prevent EXWM buffers from being selected by `other-buffer'.") + +(defvar exwm-layout--timer nil "Timer used to track echo area changes.") + +(defvar exwm-workspace--current) +(defvar exwm-workspace--frame-y-offset) +(declare-function exwm-input--release-keyboard "exwm-input.el") +(declare-function exwm-input--grab-keyboard "exwm-input.el") +(declare-function exwm-input-grab-keyboard "exwm-input.el") +(declare-function exwm-workspace--active-p "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") +(declare-function exwm-workspace--workspace-p "exwm-workspace.el" + (workspace)) +(declare-function exwm-workspace-move-window "exwm-workspace.el" + (frame-or-index &optional id)) + +(defun exwm-layout--set-state (id state) + "Set WM_STATE of X window ID to STATE." + (exwm--log "id=#x%x" id) + (xcb:+request exwm--connection + (make-instance 'xcb:icccm:set-WM_STATE + :window id :state state :icon xcb:Window:None)) + (with-current-buffer (exwm--id->buffer id) + (setq exwm-state state))) + +(defun exwm-layout--iconic-state-p (&optional id) + "Check whether X window ID is in iconic state." + (= xcb:icccm:WM_STATE:IconicState + (if id + (buffer-local-value 'exwm-state (exwm--id->buffer id)) + exwm-state))) + +(defun exwm-layout--set-ewmh-state (id) + "Set _NET_WM_STATE of X window ID to the value of variable `exwm--ewmh-state'." + (with-current-buffer (exwm--id->buffer id) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_STATE + :window exwm--id + :data exwm--ewmh-state)))) + +(defun exwm-layout--fullscreen-p () + "Check whether current `exwm-mode' buffer is in fullscreen state." + (when (derived-mode-p 'exwm-mode) + (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state))) + +(defun exwm-layout--auto-iconify () + "Helper function to iconify unused X windows. +See variable `exwm-layout-auto-iconify'." + (when (and exwm-layout-auto-iconify + (not exwm-transient-for)) + (let ((xwin exwm--id) + (state exwm-state)) + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when (and exwm--floating-frame + (eq exwm-transient-for xwin) + (not (eq exwm-state state))) + (if (eq state xcb:icccm:WM_STATE:NormalState) + (exwm-layout--refresh-floating exwm--floating-frame) + (exwm-layout--hide exwm--id)))))))) + +(defun exwm-layout--show (id &optional window) + "Show window ID exactly fit in the Emacs window WINDOW." + (exwm--log "Show #x%x in %s" id window) + (let* ((edges (window-inside-absolute-pixel-edges window)) + (x (pop edges)) + (y (pop edges)) + (width (- (pop edges) x)) + (height (- (pop edges) y)) + frame-x frame-y frame-width frame-height) + (with-current-buffer (exwm--id->buffer id) + (when exwm--floating-frame + (setq frame-width (frame-pixel-width exwm--floating-frame) + frame-height (+ (frame-pixel-height exwm--floating-frame) + ;; Use `frame-outer-height' in the future. + exwm-workspace--frame-y-offset)) + (when exwm--floating-frame-position + (setq frame-x (elt exwm--floating-frame-position 0) + frame-y (elt exwm--floating-frame-position 1) + x (+ x frame-x (- exwm-layout--floating-hidden-position)) + y (+ y frame-y (- exwm-layout--floating-hidden-position))) + (setq exwm--floating-frame-position nil)) + (exwm--set-geometry (frame-parameter exwm--floating-frame + 'exwm-container) + frame-x frame-y frame-width frame-height)) + (when (exwm-layout--fullscreen-p) + (with-slots ((x* x) + (y* y) + (width* width) + (height* height)) + (exwm-workspace--get-geometry exwm--frame) + (setq x x* + y y* + width width* + height height*))) + (exwm--set-geometry id x y width height) + (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id)) + (exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState) + (setq exwm--ewmh-state + (delq xcb:Atom:_NET_WM_STATE_HIDDEN exwm--ewmh-state)) + (exwm-layout--set-ewmh-state id) + (exwm-layout--auto-iconify))) + (xcb:flush exwm--connection)) + +(defun exwm-layout--hide (id) + "Hide window ID." + (with-current-buffer (exwm--id->buffer id) + (unless (or (exwm-layout--iconic-state-p) + (and exwm--floating-frame + exwm--desktop + (= 4294967295. exwm--desktop))) + (exwm--log "Hide #x%x" id) + (when exwm--floating-frame + (let* ((container (frame-parameter exwm--floating-frame + 'exwm-container)) + (geometry (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container)))) + (setq exwm--floating-frame-position + (vector (slot-value geometry 'x) (slot-value geometry 'y))) + (exwm--set-geometry container exwm-layout--floating-hidden-position + exwm-layout--floating-hidden-position + 1 + 1))) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:NoEvent)) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window id)) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask (exwm--get-client-event-mask))) + (exwm-layout--set-state id xcb:icccm:WM_STATE:IconicState) + (cl-pushnew xcb:Atom:_NET_WM_STATE_HIDDEN exwm--ewmh-state) + (exwm-layout--set-ewmh-state id) + (exwm-layout--auto-iconify) + (xcb:flush exwm--connection)))) + +;;;###autoload +(cl-defun exwm-layout-set-fullscreen (&optional id) + "Make window ID fullscreen." + (interactive) + (exwm--log "id=#x%x" (or id 0)) + (unless (and (or id (derived-mode-p 'exwm-mode)) + (not (exwm-layout--fullscreen-p))) + (cl-return-from exwm-layout-set-fullscreen)) + (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) + ;; Expand the X window to fill the whole screen. + (with-slots (x y width height) (exwm-workspace--get-geometry exwm--frame) + (exwm--set-geometry exwm--id x y width height)) + ;; Raise the X window. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window exwm--id + :value-mask (logior xcb:ConfigWindow:BorderWidth + xcb:ConfigWindow:StackMode) + :border-width 0 + :stack-mode xcb:StackMode:Above)) + (cl-pushnew xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state) + (exwm-layout--set-ewmh-state exwm--id) + (xcb:flush exwm--connection) + (set-window-dedicated-p (get-buffer-window) t) + (exwm-input--release-keyboard exwm--id))) + +;;;###autoload +(cl-defun exwm-layout-unset-fullscreen (&optional id) + "Restore X window ID from fullscreen state." + (interactive) + (exwm--log "id=#x%x" (or id 0)) + (unless (and (or id (derived-mode-p 'exwm-mode)) + (exwm-layout--fullscreen-p)) + (cl-return-from exwm-layout-unset-fullscreen)) + (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) + ;; `exwm-layout--show' relies on `exwm--ewmh-state' to decide whether to + ;; fullscreen the window. + (setq exwm--ewmh-state + (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)) + (exwm-layout--set-ewmh-state exwm--id) + (if exwm--floating-frame + (exwm-layout--show exwm--id (frame-root-window exwm--floating-frame)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window exwm--id + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Above)) + (let ((window (get-buffer-window nil t))) + (when window + (exwm-layout--show exwm--id window)))) + (xcb:flush exwm--connection) + (set-window-dedicated-p (get-buffer-window) nil) + (when (eq 'line-mode exwm--selected-input-mode) + (exwm-input--grab-keyboard exwm--id)))) + +;;;###autoload +(cl-defun exwm-layout-toggle-fullscreen (&optional id) + "Toggle fullscreen mode of X window ID." + (interactive (list (exwm--buffer->id (window-buffer)))) + (exwm--log "id=#x%x" (or id 0)) + (unless (or id (derived-mode-p 'exwm-mode)) + (cl-return-from exwm-layout-toggle-fullscreen)) + (when id + (with-current-buffer (exwm--id->buffer id) + (if (exwm-layout--fullscreen-p) + (exwm-layout-unset-fullscreen id) + (exwm-layout-set-fullscreen id))))) + +(defun exwm-layout--other-buffer-predicate (buffer) + "Return non-nil when the BUFFER may be displayed in selected frame. + +Prevents EXWM-mode buffers already being displayed on some other window from +being selected. + +Should be set as `buffer-predicate' frame parameter for all +frames. Used by `other-buffer'. + +When variable `exwm-layout--other-buffer-exclude-exwm-mode-buffers' +is t EXWM buffers are never selected by `other-buffer'. + +When variable `exwm-layout--other-buffer-exclude-buffers' is a +list of buffers, EXWM buffers belonging to that list are never +selected by `other-buffer'." + (or (not (with-current-buffer buffer (derived-mode-p 'exwm-mode))) + (and (not exwm-layout--other-buffer-exclude-exwm-mode-buffers) + (not (memq buffer exwm-layout--other-buffer-exclude-buffers)) + ;; Do not select if already shown in some window. + (not (get-buffer-window buffer t))))) + +(defun exwm-layout--set-client-list-stacking () + "Set _NET_CLIENT_LIST_STACKING." + (exwm--log) + (let (id clients-floating clients clients-iconic clients-other) + (dolist (pair exwm--id-buffer-alist) + (setq id (car pair)) + (with-current-buffer (cdr pair) + (if (eq exwm--frame exwm-workspace--current) + (if exwm--floating-frame + ;; A floating X window on the current workspace. + (setq clients-floating (cons id clients-floating)) + (if (get-buffer-window (cdr pair) exwm-workspace--current) + ;; A normal tilling X window on the current workspace. + (setq clients (cons id clients)) + ;; An iconic tilling X window on the current workspace. + (setq clients-iconic (cons id clients-iconic)))) + ;; X window on other workspaces. + (setq clients-other (cons id clients-other))))) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST_STACKING + :window exwm--root + :data (vconcat (append clients-other clients-iconic + clients clients-floating)))))) + +(defun exwm-layout--refresh (&optional frame) + "Refresh layout of FRAME. +If FRAME is nil, refresh layout of selected frame." + ;; `window-size-change-functions' sets this argument while + ;; `window-configuration-change-hook' makes the frame selected. + (unless frame + (setq frame (selected-frame))) + (exwm--log "frame=%s" frame) + (if (not (exwm-workspace--workspace-p frame)) + (if (frame-parameter frame 'exwm-outer-id) + (exwm-layout--refresh-floating frame) + (exwm-layout--refresh-other frame)) + (exwm-layout--refresh-workspace frame))) + +(defun exwm-layout--refresh-floating (frame) + "Refresh floating frame FRAME." + (exwm--log "Refresh floating %s" frame) + (let ((window (frame-first-window frame))) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + ;; It may be a buffer waiting to be killed. + (exwm--id->buffer exwm--id)) + (exwm--log "Refresh floating window #x%x" exwm--id) + (if (exwm-workspace--active-p exwm--frame) + (exwm-layout--show exwm--id window) + (exwm-layout--hide exwm--id)))))) + +(defun exwm-layout--refresh-other (frame) + "Refresh client or nox frame FRAME." + ;; Other frames (e.g. terminal/graphical frame of emacsclient) + ;; We shall bury all `exwm-mode' buffers in this case + (exwm--log "Refresh other %s" frame) + (let ((windows (window-list frame 'nomini)) ;exclude minibuffer + (exwm-layout--other-buffer-exclude-exwm-mode-buffers t)) + (dolist (window windows) + (with-current-buffer (window-buffer window) + (when (derived-mode-p 'exwm-mode) + (if (window-prev-buffers window) + (switch-to-prev-buffer window) + (switch-to-next-buffer window))))))) + +(defun exwm-layout--refresh-workspace (frame) + "Refresh workspace frame FRAME." + (exwm--log "Refresh workspace %s" frame) + ;; Workspaces other than the active one can also be refreshed (RandR) + (let (covered-buffers ;EXWM-buffers covered by a new X window. + vacated-windows) ;Windows previously displaying EXWM-buffers. + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when (and (not exwm--floating-frame) ;exclude floating X windows + (or exwm-layout-show-all-buffers + ;; Exclude X windows on other workspaces + (eq frame exwm--frame))) + (let (;; List of windows in current frame displaying the `exwm-mode' + ;; buffers. + (windows (get-buffer-window-list (current-buffer) 'nomini + frame))) + (if (not windows) + (when (eq frame exwm--frame) + ;; Hide it if it was being shown in this workspace. + (exwm-layout--hide exwm--id)) + (let ((window (car windows))) + (if (eq frame exwm--frame) + ;; Show it if `frame' is active, hide otherwise. + (if (exwm-workspace--active-p frame) + (exwm-layout--show exwm--id window) + (exwm-layout--hide exwm--id)) + ;; It was last shown in other workspace; move it here. + (exwm-workspace-move-window frame exwm--id)) + ;; Vacate any other windows (in any workspace) showing this + ;; `exwm-mode' buffer. + (setq vacated-windows + (append vacated-windows (remove + window + (get-buffer-window-list + (current-buffer) 'nomini t)))) + ;; Note any `exwm-mode' buffer is being covered by another + ;; `exwm-mode' buffer. We want to avoid that `exwm-mode' + ;; buffer to be reappear in any of the vacated windows. + (let ((prev-buffer (car-safe + (car-safe (window-prev-buffers window))))) + (and + prev-buffer + (with-current-buffer prev-buffer + (derived-mode-p 'exwm-mode)) + (push prev-buffer covered-buffers))))))))) + ;; Set some sensible buffer to vacated windows. + (let ((exwm-layout--other-buffer-exclude-buffers covered-buffers)) + (dolist (window vacated-windows) + (if (window-prev-buffers window) + (switch-to-prev-buffer window) + (switch-to-next-buffer window)))) + ;; Make sure windows floating / on other workspaces are excluded + (let ((exwm-layout--other-buffer-exclude-exwm-mode-buffers t)) + (dolist (window (window-list frame 'nomini)) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + (or exwm--floating-frame (not (eq frame exwm--frame)))) + (if (window-prev-buffers window) + (switch-to-prev-buffer window) + (switch-to-next-buffer window)))))) + (exwm-layout--set-client-list-stacking) + (xcb:flush exwm--connection))) + +(defun exwm-layout--on-minibuffer-setup () + "Refresh layout when minibuffer grows." + (exwm--log) + ;; Only when active minibuffer's frame is an EXWM frame. + (let* ((mini-window (active-minibuffer-window)) + (frame (window-frame mini-window))) + (when (exwm-workspace--workspace-p frame) + (exwm--defer 0 (lambda () + (when (< 1 (window-height mini-window)) + (exwm-layout--refresh frame))))))) + +(defun exwm-layout--on-echo-area-change (&optional dirty) + "Run when message arrives or in `echo-area-clear-hook' to refresh layout. +If DIRTY is non-nil, refresh layout immediately." + (let ((frame (window-frame (active-minibuffer-window))) + (msg (current-message))) + ;; Check whether the frame where current window's minibuffer resides (not + ;; current window's frame for floating windows!) must be adjusted. + (when (and msg + (exwm-workspace--workspace-p frame) + (or (cl-position ?\n msg) + (> (length msg) (frame-width frame)))) + (exwm--log) + (if dirty + (exwm-layout--refresh exwm-workspace--current) + (exwm--defer 0 #'exwm-layout--refresh exwm-workspace--current))))) + +;;;###autoload +(defun exwm-layout-enlarge-window (delta &optional horizontal) + "Make the selected window DELTA pixels taller. + +If no argument is given, make the selected window one pixel taller. If the +optional argument HORIZONTAL is non-nil, make selected window DELTA pixels +wider. If DELTA is negative, shrink selected window by -DELTA pixels. + +Normal hints are checked and regarded if the selected window is displaying an +`exwm-mode' buffer. However, this may violate the normal hints set on other X +windows." + (interactive "p") + (exwm--log) + (cond + ((zerop delta)) ;no operation + ((window-minibuffer-p)) ;avoid resize minibuffer-window + ((not (and (derived-mode-p 'exwm-mode) exwm--floating-frame)) + ;; Resize on tiling layout + (unless (= 0 (window-resizable nil delta horizontal nil t)) ;not resizable + (let ((window-resize-pixelwise t)) + (window-resize nil delta horizontal nil t)))) + ;; Resize on floating layout + (exwm--fixed-size) ;fixed size + (horizontal + (let* ((width (frame-pixel-width)) + (edges (window-inside-pixel-edges)) + (inner-width (- (elt edges 2) (elt edges 0))) + (margin (- width inner-width))) + (if (> delta 0) + (if (not exwm--normal-hints-max-width) + (cl-incf width delta) + (if (>= inner-width exwm--normal-hints-max-width) + (setq width nil) + (setq width (min (+ exwm--normal-hints-max-width margin) + (+ width delta))))) + (if (not exwm--normal-hints-min-width) + (cl-incf width delta) + (if (<= inner-width exwm--normal-hints-min-width) + (setq width nil) + (setq width (max (+ exwm--normal-hints-min-width margin) + (+ width delta)))))) + (when (and width (> width 0)) + (setf (slot-value exwm--geometry 'width) width) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-outer-id) + :value-mask xcb:ConfigWindow:Width + :width width)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-container) + :value-mask xcb:ConfigWindow:Width + :width width)) + (xcb:flush exwm--connection)))) + (t + (let* ((height (+ (frame-pixel-height) exwm-workspace--frame-y-offset)) + (edges (window-inside-pixel-edges)) + (inner-height (- (elt edges 3) (elt edges 1))) + (margin (- height inner-height))) + (if (> delta 0) + (if (not exwm--normal-hints-max-height) + (cl-incf height delta) + (if (>= inner-height exwm--normal-hints-max-height) + (setq height nil) + (setq height (min (+ exwm--normal-hints-max-height margin) + (+ height delta))))) + (if (not exwm--normal-hints-min-height) + (cl-incf height delta) + (if (<= inner-height exwm--normal-hints-min-height) + (setq height nil) + (setq height (max (+ exwm--normal-hints-min-height margin) + (+ height delta)))))) + (when (and height (> height 0)) + (setf (slot-value exwm--geometry 'height) height) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-outer-id) + :value-mask xcb:ConfigWindow:Height + :height height)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-container) + :value-mask xcb:ConfigWindow:Height + :height height)) + (xcb:flush exwm--connection)))))) + +;;;###autoload +(defun exwm-layout-enlarge-window-horizontally (delta) + "Make the selected window DELTA pixels wider. + +See also `exwm-layout-enlarge-window'." + (interactive "p") + (exwm--log "%s" delta) + (exwm-layout-enlarge-window delta t)) + +;;;###autoload +(defun exwm-layout-shrink-window (delta) + "Make the selected window DELTA pixels lower. + +See also `exwm-layout-enlarge-window'." + (interactive "p") + (exwm--log "%s" delta) + (exwm-layout-enlarge-window (- delta))) + +;;;###autoload +(defun exwm-layout-shrink-window-horizontally (delta) + "Make the selected window DELTA pixels narrower. + +See also `exwm-layout-enlarge-window'." + (interactive "p") + (exwm--log "%s" delta) + (exwm-layout-enlarge-window (- delta) t)) + +;;;###autoload +(defun exwm-layout-hide-mode-line () + "Hide mode-line." + (interactive) + (exwm--log) + (when (and (derived-mode-p 'exwm-mode) mode-line-format) + (let (mode-line-height) + (when exwm--floating-frame + (setq mode-line-height (window-mode-line-height + (frame-root-window exwm--floating-frame)))) + (setq exwm--mode-line-format mode-line-format + mode-line-format nil) + (if (not exwm--floating-frame) + (exwm-layout--show exwm--id) + (set-frame-height exwm--floating-frame + (- (frame-pixel-height exwm--floating-frame) + mode-line-height) + nil t))))) + +;;;###autoload +(defun exwm-layout-show-mode-line () + "Show mode-line." + (interactive) + (exwm--log) + (when (and (derived-mode-p 'exwm-mode) (not mode-line-format)) + (setq mode-line-format exwm--mode-line-format + exwm--mode-line-format nil) + (if (not exwm--floating-frame) + (exwm-layout--show exwm--id) + (set-frame-height exwm--floating-frame + (+ (frame-pixel-height exwm--floating-frame) + (window-mode-line-height (frame-root-window + exwm--floating-frame))) + nil t) + (call-interactively #'exwm-input-grab-keyboard)) + (force-mode-line-update))) + +;;;###autoload +(defun exwm-layout-toggle-mode-line () + "Toggle the display of mode-line." + (interactive) + (exwm--log) + (when (derived-mode-p 'exwm-mode) + (if mode-line-format + (exwm-layout-hide-mode-line) + (exwm-layout-show-mode-line)))) + +(defun exwm-layout--init () + "Initialize layout module." + ;; Auto refresh layout + (exwm--log) + (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) + ;; The behavior of `window-configuration-change-hook' will be changed. + (when (fboundp 'window-pixel-width-before-size-change) + (add-hook 'window-size-change-functions #'exwm-layout--refresh)) + (unless (exwm-workspace--minibuffer-own-frame-p) + ;; Refresh when minibuffer grows + (add-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup t) + (setq exwm-layout--timer + (run-with-idle-timer 0 t #'exwm-layout--on-echo-area-change t)) + (add-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change))) + +(defun exwm-layout--exit () + "Exit the layout module." + (exwm--log) + (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) + (when (fboundp 'window-pixel-width-before-size-change) + (remove-hook 'window-size-change-functions #'exwm-layout--refresh)) + (remove-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup) + (when exwm-layout--timer + (cancel-timer exwm-layout--timer) + (setq exwm-layout--timer nil)) + (remove-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change)) + + + +(provide 'exwm-layout) + +;;; exwm-layout.el ends here diff --git a/third_party/exwm/exwm-manage.el b/third_party/exwm/exwm-manage.el new file mode 100644 index 000000000000..ab66e298ac8e --- /dev/null +++ b/third_party/exwm/exwm-manage.el @@ -0,0 +1,833 @@ +;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*- +;;; EXWM + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the fundamental module of EXWM that deals with window management. + +;;; Code: + +(require 'exwm-core) + +(defgroup exwm-manage nil + "Manage." + :group 'exwm) + +(defcustom exwm-manage-finish-hook nil + "Normal hook run after a window is just managed. +This hook runs in the context of the corresponding `exwm-mode' buffer." + :type 'hook) + +(defcustom exwm-manage-force-tiling nil + "Non-nil to force managing all X windows in tiling layout. +You can still make the X windows floating afterwards." + :type 'boolean) + +(defcustom exwm-manage-ping-timeout 3 + "Seconds to wait before killing a client." + :type 'integer) + +(defcustom exwm-manage-configurations nil + "Per-application configurations. + +Configuration options allow to override various default behaviors of EXWM +and only take effect when they are present. Note for certain options +specifying nil is not exactly the same as leaving them out. Currently +possible choices: +* floating: Force floating (non-nil) or tiling (nil) on startup. +* x/y/width/height: Override the initial geometry (floating X window only). +* border-width: Override the border width (only visible when floating). +* fullscreen: Force full screen (non-nil) on startup. +* floating-mode-line: `mode-line-format' used when floating. +* tiling-mode-line: `mode-line-format' used when tiling. +* floating-header-line: `header-line-format' used when floating. +* tiling-header-line: `header-line-format' used when tiling. +* char-mode: Force char-mode (non-nil) on startup. +* prefix-keys: `exwm-input-prefix-keys' local to this X window. +* simulation-keys: `exwm-input-simulation-keys' local to this X window. +* workspace: The initial workspace. +* managed: Force to manage (non-nil) or not manage (nil) the X window. + +For each X window managed for the first time, matching criteria (sexps) are +evaluated sequentially and the first configuration with a non-nil matching +criterion would be applied. Apart from generic forms, one would typically +want to match against EXWM internal variables such as `exwm-title', +`exwm-class-name' and `exwm-instance-name'." + :type '(alist :key-type (sexp :tag "Matching criterion" nil) + :value-type + (plist :tag "Configurations" + :options + (((const :tag "Floating" floating) boolean) + ((const :tag "X" x) number) + ((const :tag "Y" y) number) + ((const :tag "Width" width) number) + ((const :tag "Height" height) number) + ((const :tag "Border width" border-width) integer) + ((const :tag "Fullscreen" fullscreen) boolean) + ((const :tag "Floating mode-line" floating-mode-line) + sexp) + ((const :tag "Tiling mode-line" tiling-mode-line) sexp) + ((const :tag "Floating header-line" + floating-header-line) + sexp) + ((const :tag "Tiling header-line" tiling-header-line) + sexp) + ((const :tag "Char-mode" char-mode) boolean) + ((const :tag "Prefix keys" prefix-keys) + (repeat key-sequence)) + ((const :tag "Simulation keys" simulation-keys) + (alist :key-type (key-sequence :tag "From") + :value-type (key-sequence :tag "To"))) + ((const :tag "Workspace" workspace) integer) + ((const :tag "Managed" managed) boolean) + ;; For forward compatibility. + ((other) sexp)))) + ;; TODO: This is admittedly ugly. We'd be better off with an event type. + :get (lambda (symbol) + (mapcar (lambda (pair) + (let* ((match (car pair)) + (config (cdr pair)) + (prefix-keys (plist-get config 'prefix-keys))) + (when prefix-keys + (setq config (copy-tree config) + config (plist-put config 'prefix-keys + (mapcar (lambda (i) + (if (sequencep i) + i + (vector i))) + prefix-keys)))) + (cons match config))) + (default-value symbol))) + :set (lambda (symbol value) + (set symbol + (mapcar (lambda (pair) + (let* ((match (car pair)) + (config (cdr pair)) + (prefix-keys (plist-get config 'prefix-keys))) + (when prefix-keys + (setq config (copy-tree config) + config (plist-put config 'prefix-keys + (mapcar (lambda (i) + (if (sequencep i) + (aref i 0) + i)) + prefix-keys)))) + (cons match config))) + value)))) + +;; FIXME: Make the following values as small as possible. +(defconst exwm-manage--height-delta-min 5) +(defconst exwm-manage--width-delta-min 5) + +;; The _MOTIF_WM_HINTS atom (see <Xm/MwmUtil.h> for more details) +;; It's currently only used in 'exwm-manage' module +(defvar exwm-manage--_MOTIF_WM_HINTS nil "_MOTIF_WM_HINTS atom.") + +(defvar exwm-manage--desktop nil "The desktop X window.") + +(defvar exwm-manage--frame-outer-id-list nil + "List of window-outer-id's of all frames.") + +(defvar exwm-manage--ping-lock nil + "Non-nil indicates EXWM is pinging a window.") + +(defvar exwm-input--skip-buffer-list-update) +(defvar exwm-input-prefix-keys) +(defvar exwm-workspace--current) +(defvar exwm-workspace--id-struts-alist) +(defvar exwm-workspace--list) +(defvar exwm-workspace--switch-history-outdated) +(defvar exwm-workspace-current-index) +(declare-function exwm--update-class "exwm.el" (id &optional force)) +(declare-function exwm--update-hints "exwm.el" (id &optional force)) +(declare-function exwm--update-normal-hints "exwm.el" (id &optional force)) +(declare-function exwm--update-protocols "exwm.el" (id &optional force)) +(declare-function exwm--update-struts "exwm.el" (id)) +(declare-function exwm--update-title "exwm.el" (id)) +(declare-function exwm--update-transient-for "exwm.el" (id &optional force)) +(declare-function exwm--update-desktop "exwm.el" (id &optional force)) +(declare-function exwm--update-window-type "exwm.el" (id &optional force)) +(declare-function exwm-floating--set-floating "exwm-floating.el" (id)) +(declare-function exwm-floating--unset-floating "exwm-floating.el" (id)) +(declare-function exwm-input-grab-keyboard "exwm-input.el" (&optional id)) +(declare-function exwm-input-release-keyboard "exwm-input.el" (&optional id)) +(declare-function exwm-input-set-local-simulation-keys "exwm-input.el") +(declare-function exwm-layout--fullscreen-p "exwm-layout.el" ()) +(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) +(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id)) +(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--position "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame)) +(declare-function exwm-workspace--update-struts "exwm-workspace.el" ()) +(declare-function exwm-workspace--update-workareas "exwm-workspace.el" ()) +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) + +(defun exwm-manage--update-geometry (id &optional force) + "Update geometry of X window ID. +Override current geometry if FORCE is non-nil." + (exwm--log "id=#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and exwm--geometry (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry :drawable id)))) + (setq exwm--geometry + (or reply + ;; Provide a reasonable fallback value. + (make-instance 'xcb:RECTANGLE + :x 0 + :y 0 + :width (/ (x-display-pixel-width) 2) + :height (/ (x-display-pixel-height) 2)))))))) + +(defun exwm-manage--update-ewmh-state (id) + "Update _NET_WM_STATE of X window ID." + (exwm--log "id=#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless exwm--ewmh-state + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_STATE + :window id)))) + (when reply + (setq exwm--ewmh-state (append (slot-value reply 'value) nil))))))) + +(defun exwm-manage--update-mwm-hints (id &optional force) + "Update _MOTIF_WM_HINTS of X window ID. +Override current hinds if FORCE is non-nil." + (exwm--log "id=#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and (not exwm--mwm-hints-decorations) (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:-GetProperty + :window id + :property exwm-manage--_MOTIF_WM_HINTS + :type exwm-manage--_MOTIF_WM_HINTS + :long-length 5)))) + (when reply + ;; Check MotifWmHints.decorations. + (with-slots (value) reply + (setq value (append value nil)) + (when (and value + ;; See <Xm/MwmUtil.h> for fields definitions. + (/= 0 (logand + (elt value 0) ;MotifWmHints.flags + 2)) ;MWM_HINTS_DECORATIONS + (= 0 + (elt value 2))) ;MotifWmHints.decorations + (setq exwm--mwm-hints-decorations nil)))))))) + +(defun exwm-manage--update-default-directory (id) + "Update the `default-directory' of X window ID. +Sets the `default-directory' of the EXWM buffer associated with X window to +match its current working directory. + +This only works when procfs is mounted, which may not be the case on some BSDs." + (with-current-buffer (exwm--id->buffer id) + (if-let* ((response (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_PID + :window id))) + (pid (slot-value response 'value)) + (cwd (file-symlink-p (format "/proc/%d/cwd" pid))) + ((file-accessible-directory-p cwd))) + (setq default-directory (file-name-as-directory cwd)) + (setq default-directory (expand-file-name "~/"))))) + + +(defun exwm-manage--set-client-list () + "Set _NET_CLIENT_LIST." + (exwm--log) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST + :window exwm--root + :data (vconcat (mapcar #'car exwm--id-buffer-alist))))) + +(cl-defun exwm-manage--get-configurations () + "Retrieve configurations for this buffer." + (exwm--log) + (when (derived-mode-p 'exwm-mode) + (dolist (i exwm-manage-configurations) + (save-current-buffer + (when (with-demoted-errors "Problematic configuration: %S" + (eval (car i) t)) + (cl-return-from exwm-manage--get-configurations (cdr i))))))) + +(defun exwm-manage--manage-window (id) + "Manage window ID." + (exwm--log "Try to manage #x%x" id) + (catch 'return + ;; Ensure it's alive + (when (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask (exwm--get-client-event-mask))) + (throw 'return 'dead)) + ;; Add this X window to save-set. + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeSaveSet + :mode xcb:SetMode:Insert + :window id)) + (with-current-buffer (let ((exwm-input--skip-buffer-list-update t)) + (generate-new-buffer "*EXWM*")) + ;; Keep the oldest X window first. + (setq exwm--id-buffer-alist + (nconc exwm--id-buffer-alist `((,id . ,(current-buffer))))) + (exwm-mode) + (setq exwm--id id + exwm--frame exwm-workspace--current) + (exwm--update-window-type id) + (exwm--update-class id) + (exwm--update-transient-for id) + (exwm--update-normal-hints id) + (exwm--update-hints id) + (exwm-manage--update-geometry id) + (exwm-manage--update-mwm-hints id) + (exwm--update-title id) + (exwm--update-protocols id) + (setq exwm--configurations (exwm-manage--get-configurations)) + ;; OverrideRedirect is not checked here. + (when (and + ;; The user has specified to manage it. + (not (plist-get exwm--configurations 'managed)) + (or + ;; The user has specified not to manage it. + (plist-member exwm--configurations 'managed) + ;; This is not a type of X window we can manage. + (and exwm-window-type + (not (cl-intersection + exwm-window-type + (list xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY + xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG + xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL)))) + ;; Check the _MOTIF_WM_HINTS property to not manage floating X + ;; windows without decoration. + (and (not exwm--mwm-hints-decorations) + (not exwm--hints-input) + ;; Floating windows only + (or exwm-transient-for exwm--fixed-size + (memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY + exwm-window-type) + (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG + exwm-window-type))))) + (exwm--log "No need to manage #x%x" id) + ;; Update struts. + (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK exwm-window-type) + (exwm--update-struts id)) + ;; Remove all events + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask + (if (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK + exwm-window-type) + ;; Listen for PropertyChange (struts) and + ;; UnmapNotify/DestroyNotify event of the dock. + (exwm--get-client-event-mask) + xcb:EventMask:NoEvent))) + ;; The window needs to be mapped + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window id)) + (with-slots (x y width height) exwm--geometry + ;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH + (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type) + (with-slots ((x* x) (y* y) (width* width) (height* height)) + (exwm-workspace--workarea exwm--frame) + (exwm--set-geometry id + (+ x* (/ (- width* width) 2)) + (+ y* (/ (- height* height) 2)) + nil + nil)))) + ;; Check for desktop. + (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP exwm-window-type) + ;; There should be only one desktop X window. + (setq exwm-manage--desktop id) + ;; Put it at bottom. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window id + :value-mask xcb:ConfigWindow:StackMode + :stack-mode xcb:StackMode:Below))) + (xcb:flush exwm--connection) + (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist)) + (let ((kill-buffer-query-functions nil) + (exwm-input--skip-buffer-list-update t)) + (kill-buffer (current-buffer))) + (throw 'return 'ignored)) + (let ((index (plist-get exwm--configurations 'workspace))) + (when (and index (< index (length exwm-workspace--list))) + (setq exwm--frame (elt exwm-workspace--list index)))) + ;; Manage the window + (exwm--log "Manage #x%x" id) + (xcb:+request exwm--connection ;remove border + (make-instance 'xcb:ConfigureWindow + :window id :value-mask xcb:ConfigWindow:BorderWidth + :border-width 0)) + (dolist (button ;grab buttons to set focus / move / resize + (list xcb:ButtonIndex:1 xcb:ButtonIndex:2 xcb:ButtonIndex:3)) + (xcb:+request exwm--connection + (make-instance 'xcb:GrabButton + :owner-events 0 :grab-window id + :event-mask xcb:EventMask:ButtonPress + :pointer-mode xcb:GrabMode:Sync + :keyboard-mode xcb:GrabMode:Async + :confine-to xcb:Window:None :cursor xcb:Cursor:None + :button button :modifiers xcb:ModMask:Any))) + (exwm-manage--set-client-list) + (xcb:flush exwm--connection) + (if (plist-member exwm--configurations 'floating) + ;; User has specified whether it should be floating. + (if (plist-get exwm--configurations 'floating) + (exwm-floating--set-floating id) + (with-selected-window (frame-selected-window exwm--frame) + (exwm-floating--unset-floating id))) + ;; Try to determine if it should be floating. + (if (and (not exwm-manage-force-tiling) + (or exwm-transient-for exwm--fixed-size + (memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY + exwm-window-type) + (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG + exwm-window-type))) + (exwm-floating--set-floating id) + (with-selected-window (frame-selected-window exwm--frame) + (exwm-floating--unset-floating id)))) + (if (plist-get exwm--configurations 'char-mode) + (exwm-input-release-keyboard id) + (exwm-input-grab-keyboard id)) + (when-let ((simulation-keys (plist-get exwm--configurations 'simulation-keys))) + (exwm-input-set-local-simulation-keys simulation-keys)) + (when-let ((prefix-keys (plist-get exwm--configurations 'prefix-keys))) + (setq-local exwm-input-prefix-keys prefix-keys)) + (setq exwm-workspace--switch-history-outdated t) + (exwm--update-desktop id) + (exwm-manage--update-ewmh-state id) + (exwm-manage--update-default-directory id) + (when (or (plist-get exwm--configurations 'fullscreen) + (exwm-layout--fullscreen-p)) + (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN + exwm--ewmh-state)) + (exwm-layout-set-fullscreen id)) + (run-hooks 'exwm-manage-finish-hook)))) + +(defun exwm-manage--unmanage-window (id &optional withdraw-only) + "Unmanage window ID. + +If WITHDRAW-ONLY is non-nil, the X window will be properly placed back to the +root window. Set WITHDRAW-ONLY to `quit' if this functions is used when window +manager is shutting down." + (let ((buffer (exwm--id->buffer id))) + (exwm--log "Unmanage #x%x (buffer: %s, widthdraw: %s)" + id buffer withdraw-only) + (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist)) + ;; Update workspaces when a dock is destroyed. + (when (and (null withdraw-only) + (assq id exwm-workspace--id-struts-alist)) + (setq exwm-workspace--id-struts-alist + (assq-delete-all id exwm-workspace--id-struts-alist)) + (exwm-workspace--update-struts) + (exwm-workspace--update-workareas) + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f))) + (when (and (buffer-live-p buffer) + ;; Invoked from `exwm-manage--exit' upon disconnection. + (slot-value exwm--connection 'connected)) + (with-current-buffer buffer + ;; Unmap the X window. + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window id)) + ;; + (setq exwm-workspace--switch-history-outdated t) + ;; + (when withdraw-only + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window id :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:NoEvent)) + ;; Delete WM_STATE property + (xcb:+request exwm--connection + (make-instance 'xcb:DeleteProperty + :window id :property xcb:Atom:WM_STATE)) + (cond + ((eq withdraw-only 'quit) + ;; Remap the window when exiting. + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window id))) + (t + ;; Remove _NET_WM_DESKTOP. + (xcb:+request exwm--connection + (make-instance 'xcb:DeleteProperty + :window id + :property xcb:Atom:_NET_WM_DESKTOP))))) + (when exwm--floating-frame + ;; Unmap the floating frame before destroying its container. + (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)) + (container (frame-parameter exwm--floating-frame + 'exwm-container))) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window window)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window window :parent exwm--root :x 0 :y 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow :window container)))) + (when (exwm-layout--fullscreen-p) + (let ((window (get-buffer-window))) + (when window + (set-window-dedicated-p window nil)))) + (exwm-manage--set-client-list) + (xcb:flush exwm--connection)) + (let ((kill-buffer-func + (lambda (buffer) + (when (buffer-local-value 'exwm--floating-frame buffer) + (select-window + (frame-selected-window exwm-workspace--current))) + (with-current-buffer buffer + (let ((kill-buffer-query-functions nil)) + (kill-buffer buffer)))))) + (exwm--defer 0 kill-buffer-func buffer) + (when (active-minibuffer-window) + (exit-minibuffer)))))) + +(defun exwm-manage--scan () + "Search for existing windows and try to manage them." + (exwm--log) + (let* ((tree (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryTree + :window exwm--root))) + reply) + (dolist (i (slot-value tree 'children)) + (setq reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetWindowAttributes + :window i))) + ;; It's possible the X window has been destroyed. + (when reply + (with-slots (override-redirect map-state) reply + (when (and (= 0 override-redirect) + (= xcb:MapState:Viewable map-state)) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow + :window i)) + (xcb:flush exwm--connection) + (exwm-manage--manage-window i))))))) + +(defun exwm-manage--kill-buffer-query-function () + "Run in `kill-buffer-query-functions'." + (exwm--log "id=#x%x; buffer=%s" (or exwm--id 0) (current-buffer)) + (catch 'return + (when (or (not exwm--connection) + (not (slot-value exwm--connection 'connected))) + (throw 'return t)) + (when (or (not exwm--id) + (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--id + :value-mask xcb:CW:EventMask + :event-mask (exwm--get-client-event-mask)))) + ;; The X window is no longer alive so just close the buffer. + (when exwm--floating-frame + (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)) + (container (frame-parameter exwm--floating-frame + 'exwm-container))) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow :window window)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window window + :parent exwm--root + :x 0 :y 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow + :window container)))) + (xcb:flush exwm--connection) + (throw 'return t)) + (unless (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols) + ;; The X window does not support WM_DELETE_WINDOW; destroy it. + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow :window exwm--id)) + (xcb:flush exwm--connection) + ;; Wait for DestroyNotify event. + (throw 'return nil)) + (let ((id exwm--id)) + ;; Try to close the X window with WM_DELETE_WINDOW client message. + (xcb:+request exwm--connection + (make-instance 'xcb:icccm:SendEvent + :destination id + :event (xcb:marshal + (make-instance 'xcb:icccm:WM_DELETE_WINDOW + :window id) + exwm--connection))) + (xcb:flush exwm--connection) + ;; + (unless (memq xcb:Atom:_NET_WM_PING exwm--protocols) + ;; For X windows without _NET_WM_PING support, we'd better just + ;; wait for DestroyNotify events. + (throw 'return nil)) + ;; Try to determine if the X window is dead with _NET_WM_PING. + (setq exwm-manage--ping-lock t) + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination id + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal + (make-instance 'xcb:ewmh:_NET_WM_PING + :window id + :timestamp 0 + :client-window id) + exwm--connection))) + (xcb:flush exwm--connection) + (with-timeout (exwm-manage-ping-timeout + (if (y-or-n-p (format "'%s' is not responding. \ +Would you like to kill it? " + (buffer-name))) + (progn (exwm-manage--kill-client id) + ;; Kill the unresponsive X window and + ;; wait for DestroyNotify event. + (throw 'return nil)) + ;; Give up. + (throw 'return nil))) + (while (and exwm-manage--ping-lock + (exwm--id->buffer id)) ;may have been destroyed. + (accept-process-output nil 0.1)) + ;; Give up. + (throw 'return nil))))) + +(defun exwm-manage--kill-client (&optional id) + "Kill X client ID. +If ID is nil, kill X window corresponding to current buffer." + (unless id (setq id (exwm--buffer->id (current-buffer)))) + (exwm--log "id=#x%x" id) + (let* ((response (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_PID :window id))) + (pid (and response (slot-value response 'value))) + (request (make-instance 'xcb:KillClient :resource id))) + (if (not pid) + (xcb:+request exwm--connection request) + ;; What if the PID is fake/wrong? + (signal-process pid 'SIGKILL) + ;; Ensure it's dead + (run-with-timer exwm-manage-ping-timeout nil + (lambda () + (xcb:+request exwm--connection request)))) + (xcb:flush exwm--connection))) + +(defun exwm-manage--add-frame (frame) + "Run in `after-make-frame-functions'. +FRAME is the newly created frame." + (exwm--log "frame=%s" frame) + (when (display-graphic-p frame) + (push (string-to-number (frame-parameter frame 'outer-window-id)) + exwm-manage--frame-outer-id-list))) + +(defun exwm-manage--remove-frame (frame) + "Run in `delete-frame-functions'. +FRAME is the frame to be deleted." + (exwm--log "frame=%s" frame) + (when (display-graphic-p frame) + (setq exwm-manage--frame-outer-id-list + (delq (string-to-number (frame-parameter frame 'outer-window-id)) + exwm-manage--frame-outer-id-list)))) + +(defun exwm-manage--on-ConfigureRequest (data _synthetic) + "Handle ConfigureRequest event. +DATA contains unmarshalled ConfigureRequest event data." + (exwm--log) + (let ((obj (make-instance 'xcb:ConfigureRequest)) + buffer edges width-delta height-delta) + (xcb:unmarshal obj data) + (with-slots (window x y width height + border-width sibling stack-mode value-mask) + obj + (exwm--log "#x%x (#x%x) @%dx%d%+d%+d; \ +border-width: %d; sibling: #x%x; stack-mode: %d" + window value-mask width height x y + border-width sibling stack-mode) + (if (and (setq buffer (exwm--id->buffer window)) + (with-current-buffer buffer + (or (exwm-layout--fullscreen-p) + ;; Make sure it's a floating X window wanting to resize + ;; itself. + (or (not exwm--floating-frame) + (progn + (setq edges + (window-inside-pixel-edges + (get-buffer-window buffer t)) + width-delta (- width (- (elt edges 2) + (elt edges 0))) + height-delta (- height (- (elt edges 3) + (elt edges 1)))) + ;; We cannot do resizing precisely for now. + (and (if (= 0 (logand value-mask + xcb:ConfigWindow:Width)) + t + (< (abs width-delta) + exwm-manage--width-delta-min)) + (if (= 0 (logand value-mask + xcb:ConfigWindow:Height)) + t + (< (abs height-delta) + exwm-manage--height-delta-min)))))))) + ;; Send client message for managed windows + (with-current-buffer buffer + (setq edges + (if (exwm-layout--fullscreen-p) + (with-slots (x y width height) + (exwm-workspace--get-geometry exwm--frame) + (list x y width height)) + (window-inside-absolute-pixel-edges + (get-buffer-window buffer t)))) + (exwm--log "Reply with ConfigureNotify (edges): %s" edges) + (xcb:+request exwm--connection + (make-instance 'xcb:SendEvent + :propagate 0 :destination window + :event-mask xcb:EventMask:StructureNotify + :event (xcb:marshal + (make-instance + 'xcb:ConfigureNotify + :event window :window window + :above-sibling xcb:Window:None + :x (elt edges 0) :y (elt edges 1) + :width (- (elt edges 2) (elt edges 0)) + :height (- (elt edges 3) (elt edges 1)) + :border-width 0 :override-redirect 0) + exwm--connection)))) + (if buffer + (with-current-buffer buffer + (exwm--log "ConfigureWindow (resize floating X window)") + (exwm--set-geometry (frame-parameter exwm--floating-frame + 'exwm-outer-id) + nil + nil + (+ (frame-pixel-width exwm--floating-frame) + width-delta) + (+ (frame-pixel-height exwm--floating-frame) + height-delta))) + (exwm--log "ConfigureWindow (preserve geometry)") + ;; Configure the unmanaged window. + ;; But Emacs frames should be excluded. Generally we don't + ;; receive ConfigureRequest events from Emacs frames since we + ;; have set OverrideRedirect on them, but this is not true for + ;; Lucid build (as of 25.1). + (unless (memq window exwm-manage--frame-outer-id-list) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window window + :value-mask value-mask + :x x :y y :width width :height height + :border-width border-width + :sibling sibling + :stack-mode stack-mode))))))) + (xcb:flush exwm--connection)) + +(defun exwm-manage--on-MapRequest (data _synthetic) + "Handle MapRequest event. +DATA contains unmarshalled MapRequest event data." + (let ((obj (make-instance 'xcb:MapRequest))) + (xcb:unmarshal obj data) + (with-slots (parent window) obj + (exwm--log "id=#x%x parent=#x%x" window parent) + (if (assoc window exwm--id-buffer-alist) + (with-current-buffer (exwm--id->buffer window) + (if (exwm-layout--iconic-state-p) + ;; State change: iconic => normal. + (when (eq exwm--frame exwm-workspace--current) + (pop-to-buffer-same-window (current-buffer))) + (exwm--log "#x%x is already managed" window))) + (if (/= exwm--root parent) + (progn (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window window)) + (xcb:flush exwm--connection)) + (exwm--log "#x%x" window) + (exwm-manage--manage-window window)))))) + +(defun exwm-manage--on-UnmapNotify (data _synthetic) + "Handle UnmapNotify event. +DATA contains unmarshalled UnmapNotify event data." + (let ((obj (make-instance 'xcb:UnmapNotify))) + (xcb:unmarshal obj data) + (with-slots (window) obj + (exwm--log "id=#x%x" window) + (exwm-manage--unmanage-window window t)))) + +(defun exwm-manage--on-MapNotify (data _synthetic) + "Handle MapNotify event. +DATA contains unmarshalled MapNotify event data." + (let ((obj (make-instance 'xcb:MapNotify))) + (xcb:unmarshal obj data) + (with-slots (window) obj + (when (assoc window exwm--id-buffer-alist) + (exwm--log "id=#x%x" window) + ;; With this we ensure that a "window hierarchy change" happens after + ;; mapping the window, as some servers (XQuartz) do not generate it. + (with-current-buffer (exwm--id->buffer window) + (if exwm--floating-frame + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window window + :value-mask xcb:ConfigWindow:StackMode + :stack-mode xcb:StackMode:Above)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window window + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Above)))) + (xcb:flush exwm--connection))))) + +(defun exwm-manage--on-DestroyNotify (data synthetic) + "Handle DestroyNotify event. +DATA contains unmarshalled DestroyNotify event data. +SYNTHETIC indicates whether the event is a synthetic event." + (unless synthetic + (exwm--log) + (let ((obj (make-instance 'xcb:DestroyNotify))) + (xcb:unmarshal obj data) + (exwm--log "#x%x" (slot-value obj 'window)) + (exwm-manage--unmanage-window (slot-value obj 'window))))) + +(defun exwm-manage--init () + "Initialize manage module." + ;; Intern _MOTIF_WM_HINTS + (exwm--log) + (setq exwm-manage--_MOTIF_WM_HINTS (exwm--intern-atom "_MOTIF_WM_HINTS")) + (add-hook 'after-make-frame-functions #'exwm-manage--add-frame) + (add-hook 'delete-frame-functions #'exwm-manage--remove-frame) + (xcb:+event exwm--connection 'xcb:ConfigureRequest + #'exwm-manage--on-ConfigureRequest) + (xcb:+event exwm--connection 'xcb:MapRequest #'exwm-manage--on-MapRequest) + (xcb:+event exwm--connection 'xcb:UnmapNotify #'exwm-manage--on-UnmapNotify) + (xcb:+event exwm--connection 'xcb:MapNotify #'exwm-manage--on-MapNotify) + (xcb:+event exwm--connection 'xcb:DestroyNotify + #'exwm-manage--on-DestroyNotify)) + +(defun exwm-manage--exit () + "Exit the manage module." + (exwm--log) + (dolist (pair exwm--id-buffer-alist) + (exwm-manage--unmanage-window (car pair) 'quit)) + (remove-hook 'after-make-frame-functions #'exwm-manage--add-frame) + (remove-hook 'delete-frame-functions #'exwm-manage--remove-frame) + (setq exwm-manage--_MOTIF_WM_HINTS nil)) + + + +(provide 'exwm-manage) + +;;; exwm-manage.el ends here diff --git a/third_party/exwm/exwm-randr.el b/third_party/exwm/exwm-randr.el new file mode 100644 index 000000000000..7f0e50559bfa --- /dev/null +++ b/third_party/exwm/exwm-randr.el @@ -0,0 +1,369 @@ +;;; exwm-randr.el --- RandR Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module adds RandR support for EXWM. Currently it requires external +;; tools such as xrandr(1) to properly configure RandR first. This +;; dependency may be removed in the future, but more work is needed before +;; that. + +;; To use this module, load, enable it and configure +;; `exwm-randr-workspace-monitor-plist' and `exwm-randr-screen-change-hook' +;; as follows: +;; +;; (require 'exwm-randr) +;; (setq exwm-randr-workspace-monitor-plist '(0 "VGA1")) +;; (add-hook 'exwm-randr-screen-change-hook +;; (lambda () +;; (start-process-shell-command +;; "xrandr" nil "xrandr --output VGA1 --left-of LVDS1 --auto"))) +;; (exwm-randr-enable) +;; +;; With above lines, workspace 0 should be assigned to the output named "VGA1", +;; staying at the left of other workspaces on the output "LVDS1". Please refer +;; to xrandr(1) for the configuration of RandR. + +;; References: +;; + RandR (http://www.x.org/archive/X11R7.7/doc/randrproto/randrproto.txt) + +;;; Code: + +(require 'xcb-randr) + +(require 'exwm-core) +(require 'exwm-workspace) + +(declare-function x-get-atom-name "C source code" (VALUE &optional FRAME)) + +(defgroup exwm-randr nil + "RandR." + :group 'exwm) + +(defcustom exwm-randr-refresh-hook nil + "Normal hook run when the RandR module just refreshed." + :type 'hook) + +(defcustom exwm-randr-screen-change-hook nil + "Normal hook run when screen changes." + :type 'hook) + +(defcustom exwm-randr-workspace-monitor-plist nil + "Plist mapping workspaces to monitors. + +In RandR 1.5 a monitor is a rectangle region decoupled from the physical +size of screens, and can be identified with `xrandr --listmonitors' (name of +the primary monitor is prefixed with an `*'). When no monitor is created it +automatically fallback to RandR 1.2 output which represents the physical +screen size. RandR 1.5 monitors can be created with `xrandr --setmonitor'. +For example, to split an output (`LVDS-1') of size 1280x800 into two +side-by-side monitors one could invoke (the digits after `/' are size in mm) + + xrandr --setmonitor *LVDS-1-L 640/135x800/163+0+0 LVDS-1 + xrandr --setmonitor LVDS-1-R 640/135x800/163+640+0 none + +If a monitor is not active, the workspaces mapped to it are displayed on the +primary monitor until it becomes active (if ever). Unspecified workspaces +are all mapped to the primary monitor. For example, with the following +setting workspace other than 1 and 3 would always be displayed on the +primary monitor where workspace 1 and 3 would be displayed on their +corresponding monitors whenever the monitors are active. + + \\='(1 \"HDMI-1\" 3 \"DP-1\")" + :type '(plist :key-type integer :value-type string)) + +(defvar exwm-randr--last-timestamp 0 "Used for debouncing events.") + +(defvar exwm-randr--prev-screen-change-seqnum nil + "The most recent ScreenChangeNotify sequence number.") + +(defvar exwm-randr--compatibility-mode nil + "Non-nil when the server does not support RandR 1.5 protocol.") + +(defun exwm-randr--get-monitors () + "Get RandR 1.5 monitors." + (exwm--log) + (let (monitor-name geometry monitor-geometry-alist primary-monitor) + (with-slots (timestamp monitors) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:randr:GetMonitors + :window exwm--root + :get-active 1)) + (when (> timestamp exwm-randr--last-timestamp) + (setq exwm-randr--last-timestamp timestamp)) + (dolist (monitor monitors) + (with-slots (name primary x y width height) monitor + (setq monitor-name (x-get-atom-name name) + geometry (make-instance 'xcb:RECTANGLE + :x x + :y y + :width width + :height height) + monitor-geometry-alist (cons (cons monitor-name geometry) + monitor-geometry-alist)) + (exwm--log "%s: %sx%s+%s+%s" monitor-name x y width height) + ;; Save primary monitor when available (fallback to the first one). + (when (or (/= 0 primary) + (not primary-monitor)) + (setq primary-monitor monitor-name))))) + (exwm--log "Primary monitor: %s" primary-monitor) + (list primary-monitor monitor-geometry-alist + (exwm-randr--get-monitor-alias primary-monitor + monitor-geometry-alist)))) + +(defun exwm-randr--get-outputs () + "Get RandR 1.2 outputs. + +Only used when RandR 1.5 is not supported by the server." + (exwm--log) + (let (output-name geometry output-geometry-alist primary-output) + (with-slots (config-timestamp outputs) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:randr:GetScreenResourcesCurrent + :window exwm--root)) + (when (> config-timestamp exwm-randr--last-timestamp) + (setq exwm-randr--last-timestamp config-timestamp)) + (dolist (output outputs) + (with-slots (crtc connection name) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:randr:GetOutputInfo + :output output + :config-timestamp config-timestamp)) + (when (and (= connection xcb:randr:Connection:Connected) + (/= crtc 0)) + (with-slots (x y width height) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:randr:GetCrtcInfo + :crtc crtc + :config-timestamp config-timestamp)) + (setq output-name (decode-coding-string + (apply #'unibyte-string name) 'utf-8) + geometry (make-instance 'xcb:RECTANGLE + :x x + :y y + :width width + :height height) + output-geometry-alist (cons (cons output-name geometry) + output-geometry-alist)) + (exwm--log "%s: %sx%s+%s+%s" output-name x y width height) + ;; The primary output is the first one. + (unless primary-output + (setq primary-output output-name))))))) + (exwm--log "Primary output: %s" primary-output) + (list primary-output output-geometry-alist + (exwm-randr--get-monitor-alias primary-output + output-geometry-alist)))) + +(defun exwm-randr--get-monitor-alias (primary-monitor monitor-geometry-alist) + "Generate monitor aliases using PRIMARY-MONITOR MONITOR-GEOMETRY-ALIST. + +In a mirroring setup some monitors overlap and should be treated as one." + (let (monitor-position-alist monitor-alias-alist monitor-name geometry) + (setq monitor-position-alist (with-slots (x y) + (cdr (assoc primary-monitor + monitor-geometry-alist)) + (list (cons primary-monitor (vector x y))))) + (setq monitor-alias-alist (list (cons primary-monitor primary-monitor))) + (dolist (pair monitor-geometry-alist) + (setq monitor-name (car pair) + geometry (cdr pair)) + (unless (assoc monitor-name monitor-alias-alist) + (let* ((position (vector (slot-value geometry 'x) + (slot-value geometry 'y))) + (alias (car (rassoc position monitor-position-alist)))) + (if alias + (setq monitor-alias-alist (cons (cons monitor-name alias) + monitor-alias-alist)) + (setq monitor-position-alist (cons (cons monitor-name position) + monitor-position-alist) + monitor-alias-alist (cons (cons monitor-name monitor-name) + monitor-alias-alist)))))) + monitor-alias-alist)) + +;;;###autoload +(defun exwm-randr-refresh () + "Refresh workspaces according to the updated RandR info." + (interactive) + (exwm--log) + (let* ((result (if exwm-randr--compatibility-mode + (exwm-randr--get-outputs) + (exwm-randr--get-monitors))) + (primary-monitor (elt result 0)) + (monitor-geometry-alist (elt result 1)) + (monitor-alias-alist (elt result 2)) + container-monitor-alist container-frame-alist) + (when (and primary-monitor monitor-geometry-alist) + (when exwm-workspace--fullscreen-frame-count + ;; Not all workspaces are fullscreen; reset this counter. + (setq exwm-workspace--fullscreen-frame-count 0)) + (dotimes (i (exwm-workspace--count)) + (let* ((monitor (plist-get exwm-randr-workspace-monitor-plist i)) + (geometry (cdr (assoc monitor monitor-geometry-alist))) + (frame (elt exwm-workspace--list i)) + (container (frame-parameter frame 'exwm-container))) + (if geometry + ;; Unify monitor names in case it's a mirroring setup. + (setq monitor (cdr (assoc monitor monitor-alias-alist))) + ;; Missing monitors fallback to the primary one. + (setq monitor primary-monitor + geometry (cdr (assoc primary-monitor + monitor-geometry-alist)))) + (setq container-monitor-alist (nconc + `((,container . ,(intern monitor))) + container-monitor-alist) + container-frame-alist (nconc `((,container . ,frame)) + container-frame-alist)) + (set-frame-parameter frame 'exwm-randr-monitor monitor) + (set-frame-parameter frame 'exwm-geometry geometry))) + ;; Update workareas. + (exwm-workspace--update-workareas) + ;; Resize workspace. + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f)) + (xcb:flush exwm--connection) + ;; Raise the minibuffer if it's active. + (when (and (active-minibuffer-window) + (exwm-workspace--minibuffer-own-frame-p)) + (exwm-workspace--show-minibuffer)) + ;; Set _NET_DESKTOP_GEOMETRY. + (exwm-workspace--set-desktop-geometry) + ;; Update active/inactive workspaces. + (dolist (w exwm-workspace--list) + (exwm-workspace--set-active w nil)) + ;; Mark the workspace on the top of each monitor as active. + (dolist (xwin + (reverse + (slot-value (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryTree + :window exwm--root)) + 'children))) + (let ((monitor (cdr (assq xwin container-monitor-alist)))) + (when monitor + (setq container-monitor-alist + (rassq-delete-all monitor container-monitor-alist)) + (exwm-workspace--set-active (cdr (assq xwin container-frame-alist)) + t)))) + (xcb:flush exwm--connection) + (run-hooks 'exwm-randr-refresh-hook)))) + +(defun exwm-randr--on-ScreenChangeNotify (data _synthetic) + "Handle `ScreenChangeNotify' event. + +Run `exwm-randr-screen-change-hook' (usually user scripts to configure RandR)." + (exwm--log) + (let ((evt (make-instance 'xcb:randr:ScreenChangeNotify))) + (xcb:unmarshal evt data) + (let ((seqnum (slot-value evt '~sequence))) + (unless (equal seqnum exwm-randr--prev-screen-change-seqnum) + (setq exwm-randr--prev-screen-change-seqnum seqnum) + (run-hooks 'exwm-randr-screen-change-hook))))) + +(defun exwm-randr--on-Notify (data _synthetic) + "Handle `CrtcChangeNotify' and `OutputChangeNotify' events. + +Refresh when any CRTC/output changes." + (exwm--log) + (let ((evt (make-instance 'xcb:randr:Notify)) + notify) + (xcb:unmarshal evt data) + (with-slots (subCode u) evt + (cl-case subCode + (xcb:randr:Notify:CrtcChange + (setq notify (slot-value u 'cc))) + (xcb:randr:Notify:OutputChange + (setq notify (slot-value u 'oc)))) + (when notify + (with-slots (timestamp) notify + (when (> timestamp exwm-randr--last-timestamp) + (exwm-randr-refresh) + (setq exwm-randr--last-timestamp timestamp))))))) + +(defun exwm-randr--on-ConfigureNotify (data _synthetic) + "Handle `ConfigureNotify' event. + +Refresh when any RandR 1.5 monitor changes." + (exwm--log) + (let ((evt (make-instance 'xcb:ConfigureNotify))) + (xcb:unmarshal evt data) + (with-slots (window) evt + (when (eq window exwm--root) + (exwm-randr-refresh))))) + +(defun exwm-randr--init () + "Initialize RandR extension and EXWM RandR module." + (exwm--log) + (when (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:randr) + 'present)) + (error "[EXWM] RandR extension is not supported by the server")) + (with-slots (major-version minor-version) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:randr:QueryVersion + :major-version 1 :minor-version 5)) + (cond ((and (= major-version 1) (= minor-version 5)) + (setq exwm-randr--compatibility-mode nil)) + ((and (= major-version 1) (>= minor-version 2)) + (setq exwm-randr--compatibility-mode t)) + (t + (error "[EXWM] The server only support RandR version up to %d.%d" + major-version minor-version))) + ;; External monitor(s) may already be connected. + (run-hooks 'exwm-randr-screen-change-hook) + (exwm-randr-refresh) + ;; Listen for `ScreenChangeNotify' to notify external tools to + ;; configure RandR and `CrtcChangeNotify/OutputChangeNotify' to + ;; refresh the workspace layout. + (xcb:+event exwm--connection 'xcb:randr:ScreenChangeNotify + #'exwm-randr--on-ScreenChangeNotify) + (xcb:+event exwm--connection 'xcb:randr:Notify + #'exwm-randr--on-Notify) + (xcb:+event exwm--connection 'xcb:ConfigureNotify + #'exwm-randr--on-ConfigureNotify) + (xcb:+request exwm--connection + (make-instance 'xcb:randr:SelectInput + :window exwm--root + :enable (logior + xcb:randr:NotifyMask:ScreenChange + xcb:randr:NotifyMask:CrtcChange + xcb:randr:NotifyMask:OutputChange))) + (xcb:flush exwm--connection) + (add-hook 'exwm-workspace-list-change-hook #'exwm-randr-refresh)) + ;; Prevent frame parameters introduced by this module from being + ;; saved/restored. + (dolist (i '(exwm-randr-monitor)) + (unless (assq i frameset-filter-alist) + (push (cons i :never) frameset-filter-alist)))) + +(defun exwm-randr--exit () + "Exit the RandR module." + (exwm--log) + (remove-hook 'exwm-workspace-list-change-hook #'exwm-randr-refresh)) + +(defun exwm-randr-enable () + "Enable RandR support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-randr--init) + (add-hook 'exwm-exit-hook #'exwm-randr--exit)) + + + +(provide 'exwm-randr) + +;;; exwm-randr.el ends here diff --git a/third_party/exwm/exwm-systemtray.el b/third_party/exwm/exwm-systemtray.el new file mode 100644 index 000000000000..9e57dae4ebb8 --- /dev/null +++ b/third_party/exwm/exwm-systemtray.el @@ -0,0 +1,701 @@ +;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*- +;;; EXWM + +;; Copyright (C) 2016-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module adds system tray support for EXWM. + +;; To use this module, load and enable it as follows: +;; (require 'exwm-systemtray) +;; (exwm-systemtray-enable) + +;;; Code: + +(require 'xcb-ewmh) +(require 'xcb-icccm) +(require 'xcb-xembed) +(require 'xcb-systemtray) + +(require 'exwm-core) +(require 'exwm-workspace) + +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) + +(defclass exwm-systemtray--icon () + ((width :initarg :width) + (height :initarg :height) + (visible :initarg :visible)) + :documentation "Attributes of a system tray icon.") + +(defclass xcb:systemtray:-ClientMessage + (xcb:icccm:--ClientMessage xcb:ClientMessage) + ((format :initform 32) + (type :initform 'xcb:Atom:MANAGER) + (time :initarg :time :type xcb:TIMESTAMP) ;new slot + (selection :initarg :selection :type xcb:ATOM) ;new slot + (owner :initarg :owner :type xcb:WINDOW)) ;new slot + :documentation "A systemtray client message.") + +(defgroup exwm-systemtray nil + "System tray." + :group 'exwm) + +(defcustom exwm-systemtray-height nil + "System tray height. + +You shall use the default value if using auto-hide minibuffer." + :type 'integer) + +(defcustom exwm-systemtray-icon-gap 2 + "Gap between icons." + :type 'integer) + +(defvar exwm-systemtray--connection nil "The X connection.") + +(defvar exwm-systemtray--embedder-window nil "The embedder window.") +(defvar exwm-systemtray--embedder-window-depth nil + "The embedder window's depth.") + +(defcustom exwm-systemtray-background-color 'workspace-background + "Background color of systemtray. +This should be a color, the symbol `workspace-background' for the background +color of current workspace frame, or the symbol `transparent' for transparent +background. + +Transparent background is not yet supported when Emacs uses 32-bit depth +visual, as reported by `x-display-planes'. The X resource \"Emacs.visualClass: +TrueColor-24\" can be used to force Emacs to use 24-bit depth." + :type '(choice (const :tag "Transparent" transparent) + (const :tag "Frame background" workspace-background) + (color :tag "Color")) + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (when (and (eq value 'transparent) + (not (exwm-systemtray--transparency-supported-p))) + (display-warning 'exwm-systemtray + "Transparent background is not supported yet when \ +using 32-bit depth. Using `workspace-background' instead.") + (setq value 'workspace-background)) + (set-default symbol value) + (when (and exwm-systemtray--connection + exwm-systemtray--embedder-window) + ;; Change the background color for embedder. + (exwm-systemtray--set-background-color) + ;; Unmap & map to take effect immediately. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow + :window exwm-systemtray--embedder-window)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:MapWindow + :window exwm-systemtray--embedder-window)) + (xcb:flush exwm-systemtray--connection)))) + +;; GTK icons require at least 16 pixels to show normally. +(defconst exwm-systemtray--icon-min-size 16 "Minimum icon size.") + +(defvar exwm-systemtray--list nil "The icon list.") + +(defvar exwm-systemtray--selection-owner-window nil + "The selection owner window.") + +(defvar xcb:Atom:_NET_SYSTEM_TRAY_S0) + +(defun exwm-systemtray--embed (icon) + "Embed an ICON." + (exwm--log "Try to embed #x%x" icon) + (let ((info (xcb:+request-unchecked+reply exwm-systemtray--connection + (make-instance 'xcb:xembed:get-_XEMBED_INFO + :window icon))) + width* height* visible) + (when info + (exwm--log "Embed #x%x" icon) + (with-slots (width height) + (xcb:+request-unchecked+reply exwm-systemtray--connection + (make-instance 'xcb:GetGeometry :drawable icon)) + (setq height* exwm-systemtray-height + width* (round (* width (/ (float height*) height)))) + (when (< width* exwm-systemtray--icon-min-size) + (setq width* exwm-systemtray--icon-min-size + height* (round (* height (/ (float width*) width))))) + (exwm--log "Resize from %dx%d to %dx%d" + width height width* height*)) + ;; Add this icon to save-set. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ChangeSaveSet + :mode xcb:SetMode:Insert + :window icon)) + ;; Reparent to the embedder. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ReparentWindow + :window icon + :parent exwm-systemtray--embedder-window + :x 0 + ;; Vertically centered. + :y (/ (- exwm-systemtray-height height*) 2))) + ;; Resize the icon. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ConfigureWindow + :window icon + :value-mask (logior xcb:ConfigWindow:Width + xcb:ConfigWindow:Height + xcb:ConfigWindow:BorderWidth) + :width width* + :height height* + :border-width 0)) + ;; Set event mask. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ChangeWindowAttributes + :window icon + :value-mask xcb:CW:EventMask + :event-mask (logior xcb:EventMask:ResizeRedirect + xcb:EventMask:KeyPress + xcb:EventMask:PropertyChange))) + ;; Grab all keys and forward them to Emacs frame. + (unless (exwm-workspace--minibuffer-own-frame-p) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:GrabKey + :owner-events 0 + :grab-window icon + :modifiers xcb:ModMask:Any + :key xcb:Grab:Any + :pointer-mode xcb:GrabMode:Async + :keyboard-mode xcb:GrabMode:Async))) + (setq visible (slot-value info 'flags)) + (if visible + (setq visible + (/= 0 (logand (slot-value info 'flags) xcb:xembed:MAPPED))) + ;; Default to visible. + (setq visible t)) + (when visible + (exwm--log "Map the window") + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:MapWindow :window icon))) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:xembed:SendEvent + :destination icon + :event + (xcb:marshal + (make-instance 'xcb:xembed:EMBEDDED-NOTIFY + :window icon + :time xcb:Time:CurrentTime + :embedder + exwm-systemtray--embedder-window + :version 0) + exwm-systemtray--connection))) + (push `(,icon . ,(make-instance 'exwm-systemtray--icon + :width width* + :height height* + :visible visible)) + exwm-systemtray--list) + (exwm-systemtray--refresh)))) + +(defun exwm-systemtray--unembed (icon) + "Unembed an ICON." + (exwm--log "Unembed #x%x" icon) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow :window icon)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ReparentWindow + :window icon + :parent exwm--root + :x 0 :y 0)) + (setq exwm-systemtray--list + (assq-delete-all icon exwm-systemtray--list)) + (exwm-systemtray--refresh)) + +(defun exwm-systemtray--refresh () + "Refresh the system tray." + (exwm--log) + ;; Make sure to redraw the embedder. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow + :window exwm-systemtray--embedder-window)) + (let ((x exwm-systemtray-icon-gap) + map) + (dolist (pair exwm-systemtray--list) + (when (slot-value (cdr pair) 'visible) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ConfigureWindow + :window (car pair) + :value-mask xcb:ConfigWindow:X + :x x)) + (setq x (+ x (slot-value (cdr pair) 'width) + exwm-systemtray-icon-gap)) + (setq map t))) + (let ((workarea (exwm-workspace--workarea exwm-workspace-current-index))) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ConfigureWindow + :window exwm-systemtray--embedder-window + :value-mask (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Width) + :x (- (slot-value workarea 'width) x) + :width x))) + (when map + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:MapWindow + :window exwm-systemtray--embedder-window)))) + (xcb:flush exwm-systemtray--connection)) + +(defun exwm-systemtray--refresh-background-color (&optional remap) + "Refresh background color after theme change or workspace switch. +If REMAP is not nil, map and unmap the embedder window so that the background is +redrawn." + ;; Only `workspace-background' is dependent on current theme and workspace. + (when (eq 'workspace-background exwm-systemtray-background-color) + (exwm-systemtray--set-background-color) + (when remap + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow + :window exwm-systemtray--embedder-window)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:MapWindow + :window exwm-systemtray--embedder-window)) + (xcb:flush exwm-systemtray--connection)))) + +(defun exwm-systemtray--set-background-color () + "Change the background color of the embedder. +The color is set according to `exwm-systemtray-background-color'. + +Note that this function does not change the current contents of the embedder +window; unmap & map are necessary for the background color to take effect." + (when (and exwm-systemtray--connection + exwm-systemtray--embedder-window) + (let* ((color (cl-case exwm-systemtray-background-color + ((transparent nil) ; nil means transparent as well + (if (exwm-systemtray--transparency-supported-p) + nil + (message "%s" "[EXWM] system tray does not support \ +`transparent' background; using `workspace-background' instead") + (face-background 'default exwm-workspace--current))) + (workspace-background + (face-background 'default exwm-workspace--current)) + (t exwm-systemtray-background-color))) + (background-pixel (exwm--color->pixel color))) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm-systemtray--embedder-window + ;; Either-or. A `background-pixel' of nil + ;; means simulate transparency. We use + ;; `xcb:CW:BackPixmap' together with + ;; `xcb:BackPixmap:ParentRelative' do that, + ;; but this only works when the parent + ;; window's visual (Emacs') has the same + ;; visual depth. + :value-mask (if background-pixel + xcb:CW:BackPixel + xcb:CW:BackPixmap) + ;; Due to the :value-mask above, + ;; :background-pixmap only takes effect when + ;; `transparent' is requested and supported + ;; (visual depth of Emacs and of system tray + ;; are equal). Setting + ;; `xcb:BackPixmap:ParentRelative' when + ;; that's not the case would produce an + ;; `xcb:Match' error. + :background-pixmap xcb:BackPixmap:ParentRelative + :background-pixel background-pixel))))) + +(defun exwm-systemtray--transparency-supported-p () + "Check whether transparent background is supported. +EXWM system tray supports transparency when the visual depth of the system tray +window matches that of Emacs. The visual depth of the system tray window is the +default visual depth of the display. + +Sections \"Visual and background pixmap handling\" and +\"_NET_SYSTEM_TRAY_VISUAL\" of the System Tray Protocol Specification +\(https://specifications.freedesktop.org/systemtray-spec/systemtray-spec-latest.html#visuals) +indicate how to support actual transparency." + (let ((planes (x-display-planes))) + (if exwm-systemtray--embedder-window-depth + (= planes exwm-systemtray--embedder-window-depth) + (<= planes 24)))) + +(defun exwm-systemtray--on-DestroyNotify (data _synthetic) + "Unembed icons on DestroyNotify. +Argument DATA contains the raw event data." + (exwm--log) + (let ((obj (make-instance 'xcb:DestroyNotify))) + (xcb:unmarshal obj data) + (with-slots (window) obj + (when (assoc window exwm-systemtray--list) + (exwm-systemtray--unembed window))))) + +(defun exwm-systemtray--on-ReparentNotify (data _synthetic) + "Unembed icons on ReparentNotify. +Argument DATA contains the raw event data." + (exwm--log) + (let ((obj (make-instance 'xcb:ReparentNotify))) + (xcb:unmarshal obj data) + (with-slots (window parent) obj + (when (and (/= parent exwm-systemtray--embedder-window) + (assoc window exwm-systemtray--list)) + (exwm-systemtray--unembed window))))) + +(defun exwm-systemtray--on-ResizeRequest (data _synthetic) + "Resize the tray icon on ResizeRequest. +Argument DATA contains the raw event data." + (exwm--log) + (let ((obj (make-instance 'xcb:ResizeRequest)) + attr) + (xcb:unmarshal obj data) + (with-slots (window width height) obj + (when (setq attr (cdr (assoc window exwm-systemtray--list))) + (with-slots ((width* width) + (height* height)) + attr + (setq height* exwm-systemtray-height + width* (round (* width (/ (float height*) height)))) + (when (< width* exwm-systemtray--icon-min-size) + (setq width* exwm-systemtray--icon-min-size + height* (round (* height (/ (float width*) width))))) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ConfigureWindow + :window window + :value-mask (logior xcb:ConfigWindow:Y + xcb:ConfigWindow:Width + xcb:ConfigWindow:Height) + ;; Vertically centered. + :y (/ (- exwm-systemtray-height height*) 2) + :width width* + :height height*))) + (exwm-systemtray--refresh))))) + +(defun exwm-systemtray--on-PropertyNotify (data _synthetic) + "Map/Unmap the tray icon on PropertyNotify. +Argument DATA contains the raw event data." + (exwm--log) + (let ((obj (make-instance 'xcb:PropertyNotify)) + attr info visible) + (xcb:unmarshal obj data) + (with-slots (window atom state) obj + (when (and (eq state xcb:Property:NewValue) + (eq atom xcb:Atom:_XEMBED_INFO) + (setq attr (cdr (assoc window exwm-systemtray--list)))) + (setq info (xcb:+request-unchecked+reply exwm-systemtray--connection + (make-instance 'xcb:xembed:get-_XEMBED_INFO + :window window))) + (when info + (setq visible (/= 0 (logand (slot-value info 'flags) + xcb:xembed:MAPPED))) + (exwm--log "#x%x visible? %s" window visible) + (if visible + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:MapWindow :window window)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow :window window))) + (setf (slot-value attr 'visible) visible) + (exwm-systemtray--refresh)))))) + +(defun exwm-systemtray--on-ClientMessage (data _synthetic) + "Handle client messages. +Argument DATA contains the raw event data." + (let ((obj (make-instance 'xcb:ClientMessage)) + opcode data32) + (xcb:unmarshal obj data) + (with-slots (window type data) obj + (when (eq type xcb:Atom:_NET_SYSTEM_TRAY_OPCODE) + (setq data32 (slot-value data 'data32) + opcode (elt data32 1)) + (exwm--log "opcode: %s" opcode) + (cond ((= opcode xcb:systemtray:opcode:REQUEST-DOCK) + (unless (assoc (elt data32 2) exwm-systemtray--list) + (exwm-systemtray--embed (elt data32 2)))) + ;; Not implemented (rarely used nowadays). + ((or (= opcode xcb:systemtray:opcode:BEGIN-MESSAGE) + (= opcode xcb:systemtray:opcode:CANCEL-MESSAGE))) + (t + (exwm--log "Unknown opcode message: %s" obj))))))) + +(defun exwm-systemtray--on-KeyPress (data _synthetic) + "Forward all KeyPress events to Emacs frame. +Argument DATA contains the raw event data." + (exwm--log) + ;; This function is only executed when there's no autohide minibuffer, + ;; a workspace frame has the input focus and the pointer is over a + ;; tray icon. + (let ((dest (frame-parameter (selected-frame) 'exwm-outer-id)) + (obj (make-instance 'xcb:KeyPress))) + (xcb:unmarshal obj data) + (setf (slot-value obj 'event) dest) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination dest + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal obj exwm-systemtray--connection)))) + (xcb:flush exwm-systemtray--connection)) + +(defun exwm-systemtray--on-workspace-switch () + "Reparent/Refresh the system tray in `exwm-workspace-switch-hook'." + (exwm--log) + (unless (exwm-workspace--minibuffer-own-frame-p) + (exwm-workspace--update-offsets) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ReparentWindow + :window exwm-systemtray--embedder-window + :parent (string-to-number + (frame-parameter exwm-workspace--current + 'window-id)) + :x 0 + :y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) + exwm-workspace--frame-y-offset + exwm-systemtray-height)))) + (exwm-systemtray--refresh-background-color) + (exwm-systemtray--refresh)) + +(defun exwm-systemtray--on-theme-change (_theme) + "Refresh system tray upon theme change." + (exwm-systemtray--refresh-background-color 'remap)) + +(defun exwm-systemtray--refresh-all () + "Reposition/Refresh the system tray." + (exwm--log) + (unless (exwm-workspace--minibuffer-own-frame-p) + (exwm-workspace--update-offsets) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ConfigureWindow + :window exwm-systemtray--embedder-window + :value-mask xcb:ConfigWindow:Y + :y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) + exwm-workspace--frame-y-offset + exwm-systemtray-height)))) + (exwm-systemtray--refresh)) + +(cl-defun exwm-systemtray--init () + "Initialize system tray module." + (exwm--log) + (cl-assert (not exwm-systemtray--connection)) + (cl-assert (not exwm-systemtray--list)) + (cl-assert (not exwm-systemtray--selection-owner-window)) + (cl-assert (not exwm-systemtray--embedder-window)) + (unless exwm-systemtray-height + (setq exwm-systemtray-height (max exwm-systemtray--icon-min-size + (with-selected-window (minibuffer-window) + (line-pixel-height))))) + ;; Create a new connection. + (setq exwm-systemtray--connection (xcb:connect)) + (set-process-query-on-exit-flag (slot-value exwm-systemtray--connection + 'process) + nil) + ;; Initialize XELB modules. + (xcb:xembed:init exwm-systemtray--connection t) + (xcb:systemtray:init exwm-systemtray--connection t) + ;; Acquire the manager selection _NET_SYSTEM_TRAY_S0. + (with-slots (owner) + (xcb:+request-unchecked+reply exwm-systemtray--connection + (make-instance 'xcb:GetSelectionOwner + :selection xcb:Atom:_NET_SYSTEM_TRAY_S0)) + (when (/= owner xcb:Window:None) + (xcb:disconnect exwm-systemtray--connection) + (setq exwm-systemtray--connection nil) + (warn "[EXWM] Other system tray detected") + (cl-return-from exwm-systemtray--init))) + (let ((id (xcb:generate-id exwm-systemtray--connection))) + (setq exwm-systemtray--selection-owner-window id) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid id + :parent exwm--root + :x 0 + :y 0 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOnly + :visual 0 + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + ;; Get the selection ownership. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:SetSelectionOwner + :owner id + :selection xcb:Atom:_NET_SYSTEM_TRAY_S0 + :time xcb:Time:CurrentTime)) + ;; Send a client message to announce the selection. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination exwm--root + :event-mask xcb:EventMask:StructureNotify + :event (xcb:marshal + (make-instance 'xcb:systemtray:-ClientMessage + :window exwm--root + :time xcb:Time:CurrentTime + :selection + xcb:Atom:_NET_SYSTEM_TRAY_S0 + :owner id) + exwm-systemtray--connection))) + ;; Set _NET_WM_NAME. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window id + :data "EXWM: exwm-systemtray--selection-owner-window")) + ;; Set the _NET_SYSTEM_TRAY_ORIENTATION property. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:xembed:set-_NET_SYSTEM_TRAY_ORIENTATION + :window id + :data xcb:systemtray:ORIENTATION:HORZ))) + ;; Create the embedder. + (let ((id (xcb:generate-id exwm-systemtray--connection)) + frame parent embedder-depth embedder-visual embedder-colormap y) + (setq exwm-systemtray--embedder-window id) + (if (exwm-workspace--minibuffer-own-frame-p) + (setq frame exwm-workspace--minibuffer + y (if (>= (line-pixel-height) exwm-systemtray-height) + ;; Bottom aligned. + (- (line-pixel-height) exwm-systemtray-height) + ;; Vertically centered. + (/ (- (line-pixel-height) exwm-systemtray-height) 2))) + (exwm-workspace--update-offsets) + (setq frame exwm-workspace--current + ;; Bottom aligned. + y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) + exwm-workspace--frame-y-offset + exwm-systemtray-height))) + (setq parent (string-to-number (frame-parameter frame 'window-id))) + ;; Use default depth, visual and colormap (from root window), instead of + ;; Emacs frame's. See Section "Visual and background pixmap handling" in + ;; "System Tray Protocol Specification 0.3". + (let* ((vdc (exwm--get-visual-depth-colormap exwm-systemtray--connection + exwm--root))) + (setq embedder-visual (car vdc)) + (setq embedder-depth (cadr vdc)) + (setq embedder-colormap (caddr vdc))) + ;; Note down the embedder window's depth. It will be used to check whether + ;; we can use xcb:BackPixmap:ParentRelative to emulate transparency. + (setq exwm-systemtray--embedder-window-depth embedder-depth) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:CreateWindow + :depth embedder-depth + :wid id + :parent parent + :x 0 + :y y + :width 1 + :height exwm-systemtray-height + :border-width 0 + :class xcb:WindowClass:InputOutput + :visual embedder-visual + :colormap embedder-colormap + :value-mask (logior xcb:CW:BorderPixel + xcb:CW:Colormap + xcb:CW:EventMask) + :border-pixel 0 + :event-mask xcb:EventMask:SubstructureNotify)) + (exwm-systemtray--set-background-color) + ;; Set _NET_WM_NAME. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window id + :data "EXWM: exwm-systemtray--embedder-window")) + ;; Set _NET_WM_WINDOW_TYPE. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ewmh:set-_NET_WM_WINDOW_TYPE + :window id + :data (vector xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK))) + ;; Set _NET_SYSTEM_TRAY_VISUAL. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:xembed:set-_NET_SYSTEM_TRAY_VISUAL + :window exwm-systemtray--selection-owner-window + :data embedder-visual))) + (xcb:flush exwm-systemtray--connection) + ;; Attach event listeners. + (xcb:+event exwm-systemtray--connection 'xcb:DestroyNotify + #'exwm-systemtray--on-DestroyNotify) + (xcb:+event exwm-systemtray--connection 'xcb:ReparentNotify + #'exwm-systemtray--on-ReparentNotify) + (xcb:+event exwm-systemtray--connection 'xcb:ResizeRequest + #'exwm-systemtray--on-ResizeRequest) + (xcb:+event exwm-systemtray--connection 'xcb:PropertyNotify + #'exwm-systemtray--on-PropertyNotify) + (xcb:+event exwm-systemtray--connection 'xcb:ClientMessage + #'exwm-systemtray--on-ClientMessage) + (unless (exwm-workspace--minibuffer-own-frame-p) + (xcb:+event exwm-systemtray--connection 'xcb:KeyPress + #'exwm-systemtray--on-KeyPress)) + ;; Add hook to move/reparent the embedder. + (add-hook 'exwm-workspace-switch-hook #'exwm-systemtray--on-workspace-switch) + (add-hook 'exwm-workspace--update-workareas-hook + #'exwm-systemtray--refresh-all) + ;; Add hook to update background colors. + (add-hook 'enable-theme-functions #'exwm-systemtray--on-theme-change) + (add-hook 'disable-theme-functions #'exwm-systemtray--on-theme-change) + (add-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) + (add-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) + (when (boundp 'exwm-randr-refresh-hook) + (add-hook 'exwm-randr-refresh-hook #'exwm-systemtray--refresh-all)) + ;; The struts can be updated already. + (when exwm-workspace--workareas + (exwm-systemtray--refresh-all))) + +(defun exwm-systemtray--exit () + "Exit the systemtray module." + (exwm--log) + (when exwm-systemtray--connection + (when (slot-value exwm-systemtray--connection 'connected) + ;; Hide & reparent out the embedder before disconnection to prevent + ;; embedded icons from being reparented to an Emacs frame (which is the + ;; parent of the embedder). + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow + :window exwm-systemtray--embedder-window)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ReparentWindow + :window exwm-systemtray--embedder-window + :parent exwm--root + :x 0 + :y 0)) + (xcb:disconnect exwm-systemtray--connection)) + (setq exwm-systemtray--connection nil + exwm-systemtray--list nil + exwm-systemtray--selection-owner-window nil + exwm-systemtray--embedder-window nil + exwm-systemtray--embedder-window-depth nil) + (remove-hook 'exwm-workspace-switch-hook + #'exwm-systemtray--on-workspace-switch) + (remove-hook 'exwm-workspace--update-workareas-hook + #'exwm-systemtray--refresh-all) + (remove-hook 'enable-theme-functions #'exwm-systemtray--on-theme-change) + (remove-hook 'disable-theme-functions #'exwm-systemtray--on-theme-change) + (remove-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) + (remove-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) + (when (boundp 'exwm-randr-refresh-hook) + (remove-hook 'exwm-randr-refresh-hook #'exwm-systemtray--refresh-all)))) + +(defun exwm-systemtray-enable () + "Enable system tray support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-systemtray--init) + (add-hook 'exwm-exit-hook #'exwm-systemtray--exit)) + + + +(provide 'exwm-systemtray) + +;;; exwm-systemtray.el ends here diff --git a/third_party/exwm/exwm-workspace.el b/third_party/exwm/exwm-workspace.el new file mode 100644 index 000000000000..89be6971598c --- /dev/null +++ b/third_party/exwm/exwm-workspace.el @@ -0,0 +1,1768 @@ +;;; exwm-workspace.el --- Workspace Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 1015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module adds workspace support for EXWM. + +;;; Code: + +(require 'server) + +(require 'exwm-core) + +(defgroup exwm-workspace nil + "Workspace." + :group 'exwm) + +(defcustom exwm-workspace-switch-hook nil + "Normal hook run after switching workspace." + :type 'hook) + +(defcustom exwm-workspace-list-change-hook nil + "Normal hook run when the workspace list is changed. +This happens when a workspace is added, deleted, moved, etc." + :type 'hook) + +(defcustom exwm-workspace-show-all-buffers nil + "Non-nil to show buffers on other workspaces." + :type 'boolean) + +(defcustom exwm-workspace-warp-cursor nil + "Non-nil to warp cursor automatically after workspace switch." + :type 'boolean) + +(defcustom exwm-workspace-number 1 + "Initial number of workspaces." + :type 'integer) + +(defcustom exwm-workspace-index-map #'number-to-string + "Function for mapping a workspace index to a string for display. + +By default `number-to-string' is applied which yields 0 1 2 ... ." + :type 'function) + +(defcustom exwm-workspace-minibuffer-position nil + "Position of the minibuffer frame. + +A restart is required for this change to take effect." + :type '(choice (const :tag "Bottom (fixed)" nil) + (const :tag "Bottom (auto-hide)" bottom) + (const :tag "Top (auto-hide)" top))) + +(defcustom exwm-workspace-display-echo-area-timeout 1 + "Timeout for displaying echo area." + :type 'integer) + +(defcustom exwm-workspace-switch-create-limit 10 + "Number of workspaces `exwm-workspace-switch-create' is allowed to create." + :type 'integer) + +(defvar exwm-workspace-current-index 0 "Index of current active workspace.") + +(defvar exwm-workspace--attached-minibuffer-height 0 + "Height (in pixel) of the attached minibuffer. + +If the minibuffer is detached, this value is 0.") + +(defvar exwm-workspace--create-silently nil + "When non-nil workspaces are created in the background (not switched to). + +Please manually run the hook `exwm-workspace-list-change-hook' afterwards.") + +(defvar exwm-workspace--current nil "Current active workspace.") + +(defvar exwm-workspace--display-echo-area-timer nil + "Timer for auto-hiding echo area.") + +(defvar exwm-workspace--id-struts-alist nil "Alist of X window and struts.") + +(defvar exwm-workspace--fullscreen-frame-count 0 + "Count the fullscreen workspace frames.") + +(defvar exwm-workspace--list nil "List of all workspaces (Emacs frames).") + +(defvar exwm-workspace--minibuffer nil + "The minibuffer frame shared among all frames.") + +(defvar exwm-workspace--original-handle-focus-in + (symbol-function #'handle-focus-in)) +(defvar exwm-workspace--original-handle-focus-out + (symbol-function #'handle-focus-out)) + +(defvar exwm-workspace--prompt-add-allowed nil + "Non-nil to allow adding workspace from the prompt.") + +(defvar exwm-workspace--prompt-delete-allowed nil + "Non-nil to allow deleting workspace from the prompt.") + +(defvar exwm-workspace--struts nil "Areas occupied by struts.") + +(defvar exwm-workspace--switch-history nil + "History for `read-from-minibuffer' to interactively switch workspace.") + +(defvar exwm-workspace--switch-history-outdated nil + "Non-nil to indicate `exwm-workspace--switch-history' is outdated.") + +(defvar exwm-workspace--timer nil "Timer used to track echo area changes.") + +(defvar exwm-workspace--update-workareas-hook nil + "Normal hook run when workareas get updated.") + +(defvar exwm-workspace--workareas nil "Workareas (struts excluded).") + +(defvar exwm-workspace--frame-y-offset 0 + "Offset between Emacs inner & outer frame in Y.") +(defvar exwm-workspace--window-y-offset 0 + "Offset between Emacs first window & outer frame in Y.") + +(defvar exwm-input--during-command) +(defvar exwm-input--event-hook) +(defvar exwm-layout-show-all-buffers) +(defvar exwm-manage--desktop) +(declare-function exwm-input--on-buffer-list-update "exwm-input.el" ()) +(declare-function exwm-layout--fullscreen-p "exwm-layout.el" ()) +(declare-function exwm-layout--hide "exwm-layout.el" (id)) +(declare-function exwm-layout--other-buffer-predicate "exwm-layout.el" + (buffer)) +(declare-function exwm-layout--refresh "exwm-layout.el") +(declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) + +(defsubst exwm-workspace--position (frame) + "Retrieve index of given FRAME in workspace list. +NIL if FRAME is not a workspace." + (declare (indent defun)) + (cl-position frame exwm-workspace--list)) + +(defsubst exwm-workspace--count () + "Retrieve total number of workspaces." + (length exwm-workspace--list)) + +(defsubst exwm-workspace--workspace-p (frame) + "Return t if FRAME is a workspace." + (declare (indent defun)) + (memq frame exwm-workspace--list)) + +(defsubst exwm-workspace--workarea (frame) + "Return workarea corresponding to FRAME. +FRAME may be either a workspace frame or a workspace position." + (declare (indent defun)) + (elt exwm-workspace--workareas + (if (integerp frame) + frame + (exwm-workspace--position frame)))) + +(defvar exwm-workspace--switch-map nil + "Keymap used for interactively selecting workspace.") + +(defun exwm-workspace--init-switch-map () + "Initialize variable `exwm-workspace--switch-map'." + (let ((map (make-sparse-keymap))) + (define-key map [t] (lambda () (interactive))) + (define-key map "+" #'exwm-workspace--prompt-add) + (define-key map "-" #'exwm-workspace--prompt-delete) + (dotimes (i 10) + (define-key map (int-to-string i) + #'exwm-workspace--switch-map-nth-prefix)) + (unless (eq exwm-workspace-index-map #'number-to-string) + ;; Add extra (and possibly override) keys for selecting workspace. + (dotimes (i 10) + (let ((key (funcall exwm-workspace-index-map i))) + (when (and (stringp key) + (= (length key) 1) + (<= 0 (elt key 0) 127)) + (define-key map key + (lambda () + (interactive) + (exwm-workspace--switch-map-select-nth i))))))) + (define-key map "\C-a" (lambda () (interactive) (goto-history-element 1))) + (define-key map "\C-e" (lambda () + (interactive) + (goto-history-element (exwm-workspace--count)))) + (define-key map "\C-g" #'abort-recursive-edit) + (define-key map "\C-]" #'abort-recursive-edit) + (define-key map "\C-j" #'exit-minibuffer) + ;; (define-key map "\C-m" #'exit-minibuffer) ;not working + (define-key map [return] #'exit-minibuffer) + (define-key map " " #'exit-minibuffer) + (define-key map "\C-f" #'previous-history-element) + (define-key map "\C-b" #'next-history-element) + ;; Alternative keys + (define-key map [right] #'previous-history-element) + (define-key map [left] #'next-history-element) + (setq exwm-workspace--switch-map map))) + +(defun exwm-workspace--workspace-from-frame-or-index (frame-or-index) + "Retrieve the workspace frame from FRAME-OR-INDEX." + (cond + ((framep frame-or-index) + (unless (exwm-workspace--position frame-or-index) + (user-error "[EXWM] Frame is not a workspace %S" frame-or-index)) + frame-or-index) + ((integerp frame-or-index) + (unless (and (<= 0 frame-or-index) + (< frame-or-index (exwm-workspace--count))) + (user-error "[EXWM] Workspace index out of range: %d" frame-or-index)) + (elt exwm-workspace--list frame-or-index)) + (t (user-error "[EXWM] Invalid workspace: %s" frame-or-index)))) + +(defun exwm-workspace--prompt-for-workspace (&optional prompt) + "Prompt for a workspace, returning the workspace frame. +Show PROMPT to the user if non-nil." + (exwm-workspace--update-switch-history) + (let* ((current-idx (exwm-workspace--position exwm-workspace--current)) + (history-add-new-input nil) ;prevent modifying history + (history-idx (read-from-minibuffer + (or prompt "Workspace: ") + (elt exwm-workspace--switch-history current-idx) + exwm-workspace--switch-map nil + `(exwm-workspace--switch-history . ,(1+ current-idx)))) + (workspace-idx (cl-position history-idx exwm-workspace--switch-history + :test #'equal))) + (elt exwm-workspace--list workspace-idx))) + +(defun exwm-workspace--prompt-add () + "Add workspace from the prompt." + (interactive) + (when exwm-workspace--prompt-add-allowed + (let ((exwm-workspace--create-silently t)) + (make-frame) + (run-hooks 'exwm-workspace-list-change-hook)) + (exwm-workspace--update-switch-history) + (goto-history-element minibuffer-history-position))) + +(defun exwm-workspace--prompt-delete () + "Delete workspace from the prompt." + (interactive) + (when (and exwm-workspace--prompt-delete-allowed + (< 1 (exwm-workspace--count))) + (let ((frame (elt exwm-workspace--list (1- minibuffer-history-position)))) + (if (eq frame exwm-workspace--current) + ;; Abort the recursive minibuffer if deleting the current workspace. + (progn + (exwm--defer 0 #'delete-frame frame) + (abort-recursive-edit)) + (delete-frame frame) + (exwm-workspace--update-switch-history) + (goto-history-element (min minibuffer-history-position + (exwm-workspace--count))))))) + +(defun exwm-workspace--update-switch-history () + "Update the history for switching workspace to reflect the latest status." + (when exwm-workspace--switch-history-outdated + (setq exwm-workspace--switch-history-outdated nil) + (let* ((num (exwm-workspace--count)) + (sequence (number-sequence 0 (1- num))) + (not-empty (make-vector num nil))) + (dolist (i exwm--id-buffer-alist) + (with-current-buffer (cdr i) + (when exwm--frame + (setf (aref not-empty + (exwm-workspace--position exwm--frame)) + t)))) + (setq exwm-workspace--switch-history + (mapcar + (lambda (i) + (mapconcat + (lambda (j) + (format (if (= i j) "[%s]" " %s ") + (propertize + (apply exwm-workspace-index-map (list j)) + 'face + (cond ((frame-parameter (elt exwm-workspace--list j) + 'exwm-urgency) + '(:foreground "orange")) + ((aref not-empty j) '(:foreground "green")) + (t nil))))) + sequence "")) + sequence))))) + +;;;###autoload +(defun exwm-workspace--get-geometry (frame) + "Return the geometry of frame FRAME." + (or (frame-parameter frame 'exwm-geometry) + (make-instance 'xcb:RECTANGLE + :x 0 + :y 0 + :width (x-display-pixel-width) + :height (x-display-pixel-height)))) + +;;;###autoload +(defun exwm-workspace--current-height () + "Return the height of current workspace." + (let ((geometry (frame-parameter exwm-workspace--current 'exwm-geometry))) + (if geometry + (slot-value geometry 'height) + (x-display-pixel-height)))) + +;;;###autoload +(defun exwm-workspace--minibuffer-own-frame-p () + "Reports whether the minibuffer is displayed in its own frame." + (memq exwm-workspace-minibuffer-position '(top bottom))) + +(defun exwm-workspace--update-struts () + "Update `exwm-workspace--struts'." + (setq exwm-workspace--struts nil) + (let (struts struts*) + (dolist (pair exwm-workspace--id-struts-alist) + (setq struts (cdr pair)) + (when struts + (dotimes (i 4) + (when (/= 0 (aref struts i)) + (setq struts* + (vector (aref [left right top bottom] i) + (aref struts i) + (when (= 12 (length struts)) + (substring struts (+ 4 (* i 2)) (+ 6 (* i 2)))))) + (if (= 0 (mod i 2)) + ;; Make left/top processed first. + (push struts* exwm-workspace--struts) + (setq exwm-workspace--struts + (append exwm-workspace--struts (list struts*)))))))) + (exwm--log "%s" exwm-workspace--struts))) + +(defun exwm-workspace--update-workareas () + "Update `exwm-workspace--workareas'." + (let* ((root-width (x-display-pixel-width)) + (root-height (x-display-pixel-height)) + ;; Get workareas prior to struts. + (workareas (mapcar + (lambda (frame) + (if-let (rect (frame-parameter frame 'exwm-geometry)) + ;; Use the 'exwm-geometry' frame parameter if it + ;; exists. Make sure to clone it, will be modified + ;; below! + (clone rect) + ;; Fall back to use the screen size. + (make-instance 'xcb:RECTANGLE + :x 0 + :y 0 + :width root-width + :height root-height))) + exwm-workspace--list))) + ;; Exclude areas occupied by struts. + (dolist (struts exwm-workspace--struts) + (let* ((edge (aref struts 0)) + (size (aref struts 1)) + (position (aref struts 2)) + (beg (and position (aref position 0))) + (end (and position (aref position 1))) + delta) + (dolist (w workareas) + (with-slots (x y width height) w + (pcase edge + ;; Left and top are always processed first. + ('left + (setq delta (- size x)) + (when (and (< 0 delta) + (< delta width) + (or (not position) + (< (max beg y) + (min end (+ y height))))) + (cl-decf width delta) + (setf x size))) + ('right + (setq delta (- size (- root-width x width))) + (when (and (< 0 delta) + (< delta width) + (or (not position) + (< (max beg y) + (min end (+ y height))))) + (cl-decf width delta))) + ('top + (setq delta (- size y)) + (when (and (< 0 delta) + (< delta height) + (or (not position) + (< (max beg x) + (min end (+ x width))))) + (cl-decf height delta) + (setf y size))) + ('bottom + (setq delta (- size (- root-height y height))) + (when (and (< 0 delta) + (< delta height) + (or (not position) + (< (max beg x) + (min end (+ x width))))) + (cl-decf height delta)))))))) + ;; Save the result. + (setq exwm-workspace--workareas workareas) + (xcb:flush exwm--connection)) + (exwm--log "%s" exwm-workspace--workareas) + (run-hooks 'exwm-workspace--update-workareas-hook)) + +(defun exwm-workspace--update-offsets () + "Update `exwm-workspace--frame-y-offset'/`exwm-workspace--window-y-offset'." + (exwm--log) + (if (not (and exwm-workspace--list + (or menu-bar-mode tool-bar-mode))) + (setq exwm-workspace--frame-y-offset 0 + exwm-workspace--window-y-offset 0) + (redisplay t) + (let* ((frame (elt exwm-workspace--list 0)) + (edges (window-inside-absolute-pixel-edges (frame-first-window + frame)))) + (with-slots (y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable (frame-parameter frame + 'exwm-container))) + (with-slots ((y* y)) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable (frame-parameter frame + 'exwm-outer-id))) + (with-slots ((y** y)) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable (frame-parameter frame 'exwm-id))) + (setq exwm-workspace--frame-y-offset (- y** y*) + exwm-workspace--window-y-offset (- (elt edges 1) y)))))))) + +(defun exwm-workspace--set-active (frame active) + "Make frame FRAME active on its monitor. +ACTIVE indicates whether to set the frame active or inactive." + (exwm--log "active=%s; frame=%s" active frame) + (set-frame-parameter frame 'exwm-active active) + (if active + (exwm-workspace--set-fullscreen frame) + (exwm--set-geometry (frame-parameter frame 'exwm-container) nil nil 1 1)) + (exwm-layout--refresh frame) + (xcb:flush exwm--connection)) + +(defun exwm-workspace--active-p (frame) + "Return non-nil if FRAME is active." + (frame-parameter frame 'exwm-active)) + +(defun exwm-workspace--set-fullscreen (frame) + "Make frame FRAME fullscreen according to `exwm-workspace--workareas'." + (exwm--log "frame=%s" frame) + (let ((id (frame-parameter frame 'exwm-outer-id)) + (container (frame-parameter frame 'exwm-container))) + (with-slots (x y width height) + (exwm-workspace--workarea frame) + (exwm--log "x=%s; y=%s; w=%s; h=%s" x y width height) + (when (and (eq frame exwm-workspace--current) + (exwm-workspace--minibuffer-own-frame-p)) + (exwm-workspace--resize-minibuffer-frame)) + (if (exwm-workspace--active-p frame) + (exwm--set-geometry container x y width height) + (exwm--set-geometry container x y 1 1)) + (exwm--set-geometry id nil nil width height) + (xcb:flush exwm--connection))) + ;; This is only used for workspace initialization. + (when exwm-workspace--fullscreen-frame-count + (cl-incf exwm-workspace--fullscreen-frame-count))) + +(defun exwm-workspace--resize-minibuffer-frame () + "Resize minibuffer (and its container) to fit the size of workspace." + (cl-assert (exwm-workspace--minibuffer-own-frame-p)) + (let ((workarea (exwm-workspace--workarea exwm-workspace-current-index)) + (container (frame-parameter exwm-workspace--minibuffer + 'exwm-container)) + y width) + (setq y (if (eq exwm-workspace-minibuffer-position 'top) + (- (slot-value workarea 'y) + exwm-workspace--attached-minibuffer-height) + ;; Reset the frame size. + (set-frame-height exwm-workspace--minibuffer 1) + (redisplay) ;FIXME. + (+ (slot-value workarea 'y) (slot-value workarea 'height) + (- (frame-pixel-height exwm-workspace--minibuffer)) + exwm-workspace--attached-minibuffer-height)) + width (slot-value workarea 'width)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window container + :value-mask (logior xcb:ConfigWindow:X + xcb:ConfigWindow:Y + xcb:ConfigWindow:Width + (if exwm-manage--desktop + xcb:ConfigWindow:Sibling + 0) + xcb:ConfigWindow:StackMode) + :x (slot-value workarea 'x) + :y y + :width width + :sibling exwm-manage--desktop + :stack-mode (if exwm-manage--desktop + xcb:StackMode:Above + xcb:StackMode:Below))) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm-workspace--minibuffer + 'exwm-outer-id) + :value-mask xcb:ConfigWindow:Width + :width width)) + (exwm--log "y: %s, width: %s" y width))) + +(defun exwm-workspace--switch-map-nth-prefix (&optional prefix-digits) + "Allow selecting a workspace by number. + +PREFIX-DIGITS is a list of the digits introduced so far." + (interactive) + (let* ((k (aref (substring (this-command-keys-vector) -1) 0)) + (d (- k ?0)) + ;; Convert prefix-digits to number. For example, '(2 1) to 120. + (o 1) + (pn (apply #'+ (mapcar (lambda (x) + (setq o (* 10 o)) + (* o x)) + prefix-digits))) + (n (+ pn d)) + prefix-length index-max index-length) + (if (or (= n 0) + (> n + (setq index-max (1- (exwm-workspace--count)))) + (>= (setq prefix-length (length prefix-digits)) + (setq index-length (floor (log index-max 10)))) + ;; Check if it's still possible to do a match. + (> (* n (expt 10 (- index-length prefix-length))) + index-max)) + (exwm-workspace--switch-map-select-nth n) + ;; Go ahead if there are enough digits to select any workspace. + (set-transient-map + (let ((map (make-sparse-keymap)) + (cmd (let ((digits (cons d prefix-digits))) + (lambda () + (interactive) + (exwm-workspace--switch-map-nth-prefix digits))))) + (dotimes (i 10) + (define-key map (int-to-string i) cmd)) + ;; Accept + (define-key map [return] + (lambda () + (interactive) + (exwm-workspace--switch-map-select-nth n))) + map))))) + +(defun exwm-workspace--switch-map-select-nth (n) + "Select Nth workspace." + (interactive) + (goto-history-element (1+ n)) + (exit-minibuffer)) + +;;;###autoload +(defun exwm-workspace-switch (frame-or-index &optional force) + "Switch to workspace FRAME-OR-INDEX (0-based). + +Query for the index if not specified when called interactively. Passing a +workspace frame as the first option or making use of the rest options are +for internal use only. + +When FORCE is true, allow switching to current workspace." + (interactive + (list + (cond + ((null current-prefix-arg) + (unless (and (derived-mode-p 'exwm-mode) + ;; The prompt is invisible in fullscreen mode. + (exwm-layout--fullscreen-p)) + (let ((exwm-workspace--prompt-add-allowed t) + (exwm-workspace--prompt-delete-allowed t)) + (exwm-workspace--prompt-for-workspace "Switch to [+/-]: ")))) + ((and (integerp current-prefix-arg) + (<= 0 current-prefix-arg (exwm-workspace--count))) + current-prefix-arg) + (t 0)))) + (exwm--log) + (let* ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) + (old-frame exwm-workspace--current) + (index (exwm-workspace--position frame)) + (window (frame-parameter frame 'exwm-selected-window))) + (when (or force (not (eq frame exwm-workspace--current))) + (unless (window-live-p window) + (setq window (frame-selected-window frame))) + (when (and (not (eq frame old-frame)) + (frame-live-p old-frame)) + (with-selected-frame old-frame + (funcall exwm-workspace--original-handle-focus-out + (list 'focus-out frame)))) + ;; Raise this frame. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter frame 'exwm-container) + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Below)) + (setq exwm-workspace--current frame + exwm-workspace-current-index index) + (unless (exwm-workspace--workspace-p (selected-frame)) + ;; Save the floating frame window selected on the previous workspace. + (set-frame-parameter (buffer-local-value 'exwm--frame (window-buffer)) + 'exwm-selected-window (selected-window))) + ;; Show/Hide X windows. + (let ((monitor-old (frame-parameter old-frame 'exwm-randr-monitor)) + (monitor-new (frame-parameter frame 'exwm-randr-monitor)) + (active-old (exwm-workspace--active-p old-frame)) + (active-new (exwm-workspace--active-p frame)) + workspaces-to-hide) + (cond + ((not active-old) + (exwm-workspace--set-active frame t)) + ((equal monitor-old monitor-new) + (exwm-workspace--set-active frame t) + (unless (eq frame old-frame) + (exwm-workspace--set-active old-frame nil) + (setq workspaces-to-hide (list old-frame)))) + (active-new) + (t + (dolist (w exwm-workspace--list) + (when (and (exwm-workspace--active-p w) + (equal monitor-new + (frame-parameter w 'exwm-randr-monitor))) + (exwm-workspace--set-active w nil) + (setq workspaces-to-hide (append workspaces-to-hide (list w))))) + (exwm-workspace--set-active frame t))) + (dolist (i exwm--id-buffer-alist) + (with-current-buffer (cdr i) + (if (memq exwm--frame workspaces-to-hide) + (exwm-layout--hide exwm--id) + (when (eq frame exwm--frame) + (let ((window (get-buffer-window nil t))) + (when window + (exwm-layout--show exwm--id window)))))))) + (select-window window) + (x-focus-frame (window-frame window)) ;The real input focus. + (set-frame-parameter frame 'exwm-selected-window nil) + (if (exwm-workspace--minibuffer-own-frame-p) + ;; Resize the minibuffer frame. + (exwm-workspace--resize-minibuffer-frame) + ;; Set a default minibuffer frame. + (setq default-minibuffer-frame frame)) + ;; Hide windows in other workspaces by preprending a space + (unless exwm-workspace-show-all-buffers + (dolist (i exwm--id-buffer-alist) + (with-current-buffer (cdr i) + (let ((name (replace-regexp-in-string "^\\s-*" "" + (buffer-name)))) + (exwm-workspace-rename-buffer (if (eq frame exwm--frame) + name + (concat " " name))))))) + ;; Update demands attention flag + (set-frame-parameter frame 'exwm-urgency nil) + ;; Update switch workspace history + (setq exwm-workspace--switch-history-outdated t) + ;; Set _NET_CURRENT_DESKTOP + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP + :window exwm--root :data index)) + (xcb:flush exwm--connection)) + (when exwm-workspace-warp-cursor + (with-slots (win-x win-y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:QueryPointer + :window (frame-parameter frame + 'exwm-outer-id))) + (when (or (< win-x 0) + (< win-y 0) + (> win-x (frame-pixel-width frame)) + (> win-y (frame-pixel-height frame))) + (xcb:+request exwm--connection + (make-instance 'xcb:WarpPointer + :src-window xcb:Window:None + :dst-window (frame-parameter frame + 'exwm-outer-id) + :src-x 0 + :src-y 0 + :src-width 0 + :src-height 0 + :dst-x (/ (frame-pixel-width frame) 2) + :dst-y (/ (frame-pixel-height frame) 2))) + (xcb:flush exwm--connection)))) + (funcall exwm-workspace--original-handle-focus-in (list 'focus-in frame)) + (run-hooks 'exwm-workspace-switch-hook))) + +;;;###autoload +(defun exwm-workspace-switch-create (frame-or-index) + "Switch to workspace FRAME-OR-INDEX creating it first non-existent. + +Passing a workspace frame as the first option is for internal use only." + (interactive + (list + (cond + ((integerp current-prefix-arg) + current-prefix-arg) + (t 0)))) + (unless frame-or-index + (setq frame-or-index 0)) + (exwm--log "%s" frame-or-index) + (if (or (framep frame-or-index) + (< frame-or-index (exwm-workspace--count))) + (exwm-workspace-switch frame-or-index) + (let ((exwm-workspace--create-silently t)) + (dotimes (_ (min exwm-workspace-switch-create-limit + (1+ (- frame-or-index + (exwm-workspace--count))))) + (make-frame)) + (run-hooks 'exwm-workspace-list-change-hook)) + (exwm-workspace-switch frame-or-index))) + +;;;###autoload +(defun exwm-workspace-swap (workspace1 workspace2) + "Interchange position of WORKSPACE1 with that of WORKSPACE2." + (interactive + (unless (and (derived-mode-p 'exwm-mode) + ;; The prompt is invisible in fullscreen mode. + (exwm-layout--fullscreen-p)) + (let (w1 w2) + (let ((exwm-workspace--prompt-add-allowed t) + (exwm-workspace--prompt-delete-allowed t)) + (setq w1 (exwm-workspace--prompt-for-workspace + "Pick a workspace [+/-]: "))) + (setq w2 (exwm-workspace--prompt-for-workspace + (format "Swap workspace %d with: " + (exwm-workspace--position w1)))) + (list w1 w2)))) + (exwm--log) + (let ((pos1 (exwm-workspace--position workspace1)) + (pos2 (exwm-workspace--position workspace2))) + (if (or (not pos1) (not pos2) (= pos1 pos2)) + (user-error "[EXWM] Cannot swap %s and %s" workspace1 workspace2) + (setf (elt exwm-workspace--list pos1) workspace2) + (setf (elt exwm-workspace--list pos2) workspace1) + ;; Update the _NET_WM_DESKTOP property of each X window affected. + (dolist (pair exwm--id-buffer-alist) + (when (memq (buffer-local-value 'exwm--frame (cdr pair)) + (list workspace1 workspace2)) + (exwm-workspace--set-desktop (car pair)))) + (xcb:flush exwm--connection) + (when (memq exwm-workspace--current (list workspace1 workspace2)) + ;; With the current workspace involved, lots of stuffs need refresh. + (set-frame-parameter exwm-workspace--current 'exwm-selected-window + (selected-window)) + (exwm-workspace-switch exwm-workspace--current t)) + (run-hooks 'exwm-workspace-list-change-hook)))) + +;;;###autoload +(defun exwm-workspace-move (workspace nth) + "Move WORKSPACE to the NTH position. + +When called interactively, prompt for a workspace and move current one just +before it." + (interactive + (cond + ((null current-prefix-arg) + (unless (and (derived-mode-p 'exwm-mode) + ;; The prompt is invisible in fullscreen mode. + (exwm-layout--fullscreen-p)) + (list exwm-workspace--current + (exwm-workspace--position + (exwm-workspace--prompt-for-workspace "Move workspace to: "))))) + ((and (integerp current-prefix-arg) + (<= 0 current-prefix-arg (exwm-workspace--count))) + (list exwm-workspace--current current-prefix-arg)) + (t (list exwm-workspace--current 0)))) + (exwm--log) + (let ((pos (exwm-workspace--position workspace)) + flag start end index) + (if (= nth pos) + (user-error "[EXWM] Cannot move to same position") + ;; Set if the current workspace is involved. + (setq flag (or (eq workspace exwm-workspace--current) + (eq (elt exwm-workspace--list nth) + exwm-workspace--current))) + ;; Do the move. + (with-no-warnings ;For Emacs 24. + (pop (nthcdr pos exwm-workspace--list))) + (push workspace (nthcdr nth exwm-workspace--list)) + ;; Update the _NET_WM_DESKTOP property of each X window affected. + (setq start (min pos nth) + end (max pos nth)) + (dolist (pair exwm--id-buffer-alist) + (setq index (exwm-workspace--position + (buffer-local-value 'exwm--frame (cdr pair)))) + (unless (or (< index start) (> index end)) + (exwm-workspace--set-desktop (car pair)))) + (when flag + ;; With the current workspace involved, lots of stuffs need refresh. + (set-frame-parameter exwm-workspace--current 'exwm-selected-window + (selected-window)) + (exwm-workspace-switch exwm-workspace--current t)) + (run-hooks 'exwm-workspace-list-change-hook)))) + +;;;###autoload +(defun exwm-workspace-add (&optional index) + "Add a workspace as the INDEX-th workspace, or the last one if INDEX is nil. + +INDEX must not exceed the current number of workspaces." + (interactive) + (exwm--log "%s" index) + (if (and index + ;; No need to move if it's the last one. + (< index (exwm-workspace--count))) + (exwm-workspace-move (make-frame) index) + (make-frame))) + +;;;###autoload +(defun exwm-workspace-delete (&optional frame-or-index) + "Delete the workspace FRAME-OR-INDEX." + (interactive) + (exwm--log "%s" frame-or-index) + (when (< 1 (exwm-workspace--count)) + (let ((frame (if frame-or-index + (exwm-workspace--workspace-from-frame-or-index + frame-or-index) + exwm-workspace--current))) + (delete-frame frame)))) + +(defun exwm-workspace--set-desktop (id) + "Set _NET_WM_DESKTOP for X window ID." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (let ((desktop (exwm-workspace--position exwm--frame))) + (setq exwm--desktop desktop) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_DESKTOP + :window id + :data desktop))))) + +;;;###autoload +(cl-defun exwm-workspace-move-window (frame-or-index &optional id) + "Move window ID to workspace FRAME-OR-INDEX." + (interactive (list + (cond + ((null current-prefix-arg) + (let ((exwm-workspace--prompt-add-allowed t) + (exwm-workspace--prompt-delete-allowed t)) + (exwm-workspace--prompt-for-workspace "Move to [+/-]: "))) + ((and (integerp current-prefix-arg) + (<= 0 current-prefix-arg (exwm-workspace--count))) + current-prefix-arg) + (t 0)))) + (let ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) + old-frame container) + (unless id (setq id (exwm--buffer->id (window-buffer)))) + (unless id + (cl-return-from exwm-workspace-move-window)) + (exwm--log "Moving #x%x to %s" id frame-or-index) + (with-current-buffer (exwm--id->buffer id) + (unless (eq exwm--frame frame) + (unless exwm-workspace-show-all-buffers + (let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name)))) + (exwm-workspace-rename-buffer + (if (eq frame exwm-workspace--current) + name + (concat " " name))))) + (setq old-frame exwm--frame + exwm--frame frame) + (if (not exwm--floating-frame) + ;; Tiling. + (if (get-buffer-window nil frame) + (when (eq frame exwm-workspace--current) + (exwm-layout--refresh frame)) + (set-window-buffer (get-buffer-window nil t) + (other-buffer nil t)) + (unless (eq frame exwm-workspace--current) + ;; Clear the 'exwm-selected-window' frame parameter. + (set-frame-parameter frame 'exwm-selected-window nil)) + (set-window-buffer (frame-selected-window frame) + (exwm--id->buffer id)) + (if (eq frame exwm-workspace--current) + (select-window (frame-selected-window frame)) + (unless (exwm-workspace--active-p frame) + (exwm-layout--hide id)))) + ;; Floating. + (setq container (frame-parameter exwm--floating-frame + 'exwm-container)) + (unless (equal (frame-parameter old-frame 'exwm-randr-monitor) + (frame-parameter frame 'exwm-randr-monitor)) + (with-slots (x y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container)) + (with-slots ((x1 x) + (y1 y)) + (exwm-workspace--get-geometry old-frame) + (with-slots ((x2 x) + (y2 y)) + (exwm-workspace--get-geometry frame) + (setq x (+ x (- x2 x1)) + y (+ y (- y2 y1))))) + (exwm--set-geometry id x y nil nil) + (exwm--set-geometry container x y nil nil))) + (if (exwm-workspace--minibuffer-own-frame-p) + (if (eq frame exwm-workspace--current) + (select-window (frame-root-window exwm--floating-frame)) + (select-window (frame-selected-window exwm-workspace--current)) + (unless (exwm-workspace--active-p frame) + (exwm-layout--hide id))) + ;; The frame needs to be recreated since it won't use the + ;; minibuffer on the new workspace. + ;; The code is mostly copied from `exwm-floating--set-floating'. + (let* ((old-frame exwm--floating-frame) + (new-frame + (with-current-buffer + (or (get-buffer "*scratch*") + (progn + (set-buffer-major-mode + (get-buffer-create "*scratch*")) + (get-buffer "*scratch*"))) + (make-frame + `((minibuffer . ,(minibuffer-window frame)) + (left . ,(* window-min-width -100)) + (top . ,(* window-min-height -100)) + (width . ,window-min-width) + (height . ,window-min-height) + (unsplittable . t))))) + (outer-id (string-to-number + (frame-parameter new-frame + 'outer-window-id))) + (window-id (string-to-number + (frame-parameter new-frame 'window-id))) + (window (frame-root-window new-frame))) + (set-frame-parameter new-frame 'exwm-outer-id outer-id) + (set-frame-parameter new-frame 'exwm-id window-id) + (set-frame-parameter new-frame 'exwm-container container) + (make-frame-invisible new-frame) + (set-frame-size new-frame + (frame-pixel-width old-frame) + (frame-pixel-height old-frame) + t) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window outer-id + :parent container + :x 0 :y 0)) + (xcb:flush exwm--connection) + (with-current-buffer (exwm--id->buffer id) + (setq window-size-fixed nil + exwm--floating-frame new-frame) + (set-window-dedicated-p (frame-root-window old-frame) nil) + (remove-hook 'window-configuration-change-hook + #'exwm-layout--refresh) + (set-window-buffer window (current-buffer)) + (add-hook 'window-configuration-change-hook + #'exwm-layout--refresh) + (set-window-dedicated-p window t)) + ;; Select a tiling window and delete the old frame. + (select-window (frame-selected-window exwm-workspace--current)) + (delete-frame old-frame) + ;; The rest is the same. + (make-frame-visible new-frame) + (exwm--set-geometry outer-id 0 0 nil nil) + (xcb:flush exwm--connection) + (redisplay) + (if (eq frame exwm-workspace--current) + (with-current-buffer (exwm--id->buffer id) + (select-window (frame-root-window exwm--floating-frame))) + (unless (exwm-workspace--active-p frame) + (exwm-layout--hide id))))) + ;; Update the 'exwm-selected-window' frame parameter. + (when (not (eq frame exwm-workspace--current)) + (with-current-buffer (exwm--id->buffer id) + (set-frame-parameter frame 'exwm-selected-window + (frame-root-window + exwm--floating-frame))))) + ;; Set _NET_WM_DESKTOP. + (exwm-workspace--set-desktop id) + (xcb:flush exwm--connection))) + (setq exwm-workspace--switch-history-outdated t))) + +;;;###autoload +(defun exwm-workspace-switch-to-buffer (buffer-or-name) + "Make selected window display BUFFER-OR-NAME." + (interactive + (let ((inhibit-quit t)) + ;; Show all buffers + (unless exwm-workspace-show-all-buffers + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when (= ?\s (aref (buffer-name) 0)) + (let ((buffer-list-update-hook + (remq #'exwm-input--on-buffer-list-update + buffer-list-update-hook))) + (rename-buffer (substring (buffer-name) 1))))))) + (prog1 + (with-local-quit + (list (get-buffer (read-buffer-to-switch "Switch to buffer: ")))) + ;; Hide buffers on other workspaces + (unless exwm-workspace-show-all-buffers + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (unless (or (eq exwm--frame exwm-workspace--current) + (= ?\s (aref (buffer-name) 0))) + (let ((buffer-list-update-hook + (remq #'exwm-input--on-buffer-list-update + buffer-list-update-hook))) + (rename-buffer (concat " " (buffer-name))))))))))) + (exwm--log) + (when buffer-or-name + (with-current-buffer buffer-or-name + (if (derived-mode-p 'exwm-mode) + ;; EXWM buffer. + (if (eq exwm--frame exwm-workspace--current) + ;; On the current workspace. + (if (not exwm--floating-frame) + (switch-to-buffer buffer-or-name) + ;; Select the floating frame. + (select-frame-set-input-focus exwm--floating-frame) + (select-window (frame-root-window exwm--floating-frame))) + ;; On another workspace. + (if exwm-layout-show-all-buffers + (exwm-workspace-move-window exwm-workspace--current + exwm--id) + (let ((window (get-buffer-window buffer-or-name exwm--frame))) + (if window + (set-frame-parameter exwm--frame + 'exwm-selected-window window) + (set-window-buffer (frame-selected-window exwm--frame) + buffer-or-name))) + (exwm-workspace-switch exwm--frame))) + ;; Ordinary buffer. + (switch-to-buffer buffer-or-name))))) + +(defun exwm-workspace-rename-buffer (newname) + "Rename current buffer to NEWNAME." + (let ((hidden (= ?\s (aref newname 0))) + (basename (replace-regexp-in-string "<[0-9]+>$" "" newname)) + (counter 1) + tmp) + (when hidden (setq basename (substring basename 1))) + (setq newname basename) + (while (and (setq tmp (or (get-buffer newname) + (get-buffer (concat " " newname)))) + (not (eq tmp (current-buffer)))) + (setq newname (format "%s<%d>" basename (cl-incf counter)))) + (let ((buffer-list-update-hook + (remq #'exwm-input--on-buffer-list-update + buffer-list-update-hook))) + (rename-buffer (concat (and hidden " ") newname))))) + +(defun exwm-workspace--x-create-frame (orig-x-create-frame params) + "Set override-redirect on the frame created by `x-create-frame'. +ORIG-X-CREATE-FRAME is the advised function `x-create-frame'. +PARAMS are the original arguments." + (exwm--log) + (let ((frame (funcall orig-x-create-frame params))) + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window (string-to-number + (frame-parameter frame 'outer-window-id)) + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + (xcb:flush exwm--connection) + frame)) + +(defsubst exwm-workspace--minibuffer-attached-p () + "Return non-nil if the minibuffer is attached. + +Please check `exwm-workspace--minibuffer-own-frame-p' first." + (assq (frame-parameter exwm-workspace--minibuffer 'exwm-container) + exwm-workspace--id-struts-alist)) + +;;;###autoload +(defun exwm-workspace-attach-minibuffer () + "Attach the minibuffer making it always visible." + (interactive) + (exwm--log) + (when (and (exwm-workspace--minibuffer-own-frame-p) + (not (exwm-workspace--minibuffer-attached-p))) + ;; Reset the frame size. + (set-frame-height exwm-workspace--minibuffer 1) + (redisplay) ;FIXME. + (setq exwm-workspace--attached-minibuffer-height + (frame-pixel-height exwm-workspace--minibuffer)) + (exwm-workspace--show-minibuffer) + (let ((container (frame-parameter exwm-workspace--minibuffer + 'exwm-container))) + (push (cons container + (if (eq exwm-workspace-minibuffer-position 'top) + (vector 0 0 exwm-workspace--attached-minibuffer-height 0) + (vector 0 0 0 exwm-workspace--attached-minibuffer-height))) + exwm-workspace--id-struts-alist) + (exwm-workspace--update-struts) + (exwm-workspace--update-workareas) + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f))))) + +;;;###autoload +(defun exwm-workspace-detach-minibuffer () + "Detach the minibuffer so that it automatically hides." + (interactive) + (exwm--log) + (when (and (exwm-workspace--minibuffer-own-frame-p) + (exwm-workspace--minibuffer-attached-p)) + (setq exwm-workspace--attached-minibuffer-height 0) + (let ((container (frame-parameter exwm-workspace--minibuffer + 'exwm-container))) + (setq exwm-workspace--id-struts-alist + (assq-delete-all container exwm-workspace--id-struts-alist)) + (exwm-workspace--update-struts) + (exwm-workspace--update-workareas) + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f)) + (exwm-workspace--hide-minibuffer)))) + +;;;###autoload +(defun exwm-workspace-toggle-minibuffer () + "Attach the minibuffer if it's detached, or detach it if it's attached." + (interactive) + (exwm--log) + (when (exwm-workspace--minibuffer-own-frame-p) + (if (exwm-workspace--minibuffer-attached-p) + (exwm-workspace-detach-minibuffer) + (exwm-workspace-attach-minibuffer)))) + +(defun exwm-workspace--update-minibuffer-height (&optional echo-area) + "Update the minibuffer frame height. +When ECHO-AREA is non-nil, take the size of the echo area into +account when calculating the height." + (when (exwm--terminal-p) + (let ((height + (with-current-buffer + (window-buffer (minibuffer-window exwm-workspace--minibuffer)) + (max 1 + (if echo-area + (let ((width (frame-width exwm-workspace--minibuffer)) + (result 0)) + (mapc (lambda (i) + (setq result + (+ result + (ceiling (1+ (length i)) width)))) + (split-string (or (current-message) "") "\n")) + result) + (count-screen-lines)))))) + (when (and (integerp max-mini-window-height) + (> height max-mini-window-height)) + (setq height max-mini-window-height)) + (exwm--log "%s" height) + (set-frame-height exwm-workspace--minibuffer height)))) + +(defun exwm-workspace--on-ConfigureNotify (data _synthetic) + "Adjust the container to fit the minibuffer frame. +DATA contains unmarshalled ConfigureNotify event data." + (let ((obj (make-instance 'xcb:ConfigureNotify)) y) + (xcb:unmarshal obj data) + (with-slots (window height) obj + (when (eq (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id) + window) + (exwm--log) + (when (and (floatp max-mini-window-height) + (> height (* max-mini-window-height + (exwm-workspace--current-height)))) + (setq height (floor + (* max-mini-window-height + (exwm-workspace--current-height)))) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window window + :value-mask xcb:ConfigWindow:Height + :height height))) + (when (/= (exwm-workspace--count) (length exwm-workspace--workareas)) + ;; There is a chance the workareas are not updated timely. + (exwm-workspace--update-workareas)) + (with-slots ((y* y) (height* height)) + (exwm-workspace--workarea exwm-workspace-current-index) + (setq y (if (eq exwm-workspace-minibuffer-position 'top) + (- y* + exwm-workspace--attached-minibuffer-height) + (+ y* height* (- height) + exwm-workspace--attached-minibuffer-height)))) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm-workspace--minibuffer + 'exwm-container) + :value-mask (logior xcb:ConfigWindow:Y + xcb:ConfigWindow:Height) + :y y + :height height)) + (xcb:flush exwm--connection))))) + +(defun exwm-workspace--display-buffer (buffer alist) + "Display BUFFER as if the current workspace were selected. +ALIST is an action alist, as accepted by function `display-buffer'." + ;; Only when the floating minibuffer frame is selected. + ;; This also protect this functions from being recursively called. + (when (eq (selected-frame) exwm-workspace--minibuffer) + (with-selected-frame exwm-workspace--current + (display-buffer buffer alist)))) + +(defun exwm-workspace--show-minibuffer () + "Show the minibuffer frame." + (exwm--log) + ;; Cancel pending timer. + (when exwm-workspace--display-echo-area-timer + (cancel-timer exwm-workspace--display-echo-area-timer) + (setq exwm-workspace--display-echo-area-timer nil)) + ;; Show the minibuffer frame. + (unless (exwm-workspace--minibuffer-attached-p) + (exwm--set-geometry (frame-parameter exwm-workspace--minibuffer + 'exwm-container) + nil nil + (frame-pixel-width exwm-workspace--minibuffer) + (frame-pixel-height exwm-workspace--minibuffer))) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm-workspace--minibuffer + 'exwm-container) + :value-mask xcb:ConfigWindow:StackMode + :stack-mode xcb:StackMode:Above)) + (xcb:flush exwm--connection)) + +(defun exwm-workspace--hide-minibuffer () + "Hide the minibuffer frame." + (exwm--log) + ;; Hide the minibuffer frame. + (if (exwm-workspace--minibuffer-attached-p) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm-workspace--minibuffer + 'exwm-container) + :value-mask (logior (if exwm-manage--desktop + xcb:ConfigWindow:Sibling + 0) + xcb:ConfigWindow:StackMode) + :sibling exwm-manage--desktop + :stack-mode (if exwm-manage--desktop + xcb:StackMode:Above + xcb:StackMode:Below))) + (exwm--set-geometry (frame-parameter exwm-workspace--minibuffer + 'exwm-container) + nil nil 1 1)) + (xcb:flush exwm--connection)) + +(defun exwm-workspace--on-minibuffer-setup () + "Run in `minibuffer-setup-hook' to show the minibuffer and its container." + (exwm--log) + (when (and (= 1 (minibuffer-depth)) + (exwm--terminal-p)) + (add-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) + (exwm-workspace--show-minibuffer)) + ;; FIXME: This is a temporary fix for the *Completions* buffer not + ;; being correctly fitted by its displaying window. As with + ;; `exwm-workspace--display-buffer', the problem is caused by + ;; the fact that the minibuffer (rather than the workspace) + ;; frame is the 'selected frame'. `get-buffer-window' will + ;; fail to retrieve the correct window. It's likely there are + ;; other related issues. + ;; This is not required by Emacs 24. + (when (fboundp 'window-preserve-size) + (let ((window (get-buffer-window "*Completions*" + exwm-workspace--current))) + (when window + (fit-window-to-buffer window) + (window-preserve-size window))))) + +(defun exwm-workspace--on-minibuffer-exit () + "Run in `minibuffer-exit-hook' to hide the minibuffer container." + (exwm--log) + (when (and (= 1 (minibuffer-depth)) + (exwm--terminal-p)) + (remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) + (exwm-workspace--hide-minibuffer))) + +(defun exwm-workspace--on-echo-area-dirty () + "Run when new message arrives to show the echo area and its container." + (when (and (not (active-minibuffer-window)) + (or (current-message) + cursor-in-echo-area) + (exwm--terminal-p)) + (exwm-workspace--update-minibuffer-height t) + (exwm-workspace--show-minibuffer) + (unless (or (not exwm-workspace-display-echo-area-timeout) + exwm-input--during-command ;e.g. read-event + input-method-use-echo-area) + (setq exwm-workspace--display-echo-area-timer + (run-with-timer exwm-workspace-display-echo-area-timeout nil + #'exwm-workspace--echo-area-maybe-clear))))) + +(defun exwm-workspace--echo-area-maybe-clear () + "Eventually clear the echo area container." + (exwm--log) + (if (not (current-message)) + (exwm-workspace--on-echo-area-clear) + ;; Reschedule. + (cancel-timer exwm-workspace--display-echo-area-timer) + (setq exwm-workspace--display-echo-area-timer + (run-with-timer exwm-workspace-display-echo-area-timeout nil + #'exwm-workspace--echo-area-maybe-clear)))) + +(defun exwm-workspace--on-echo-area-clear () + "Run in `echo-area-clear-hook' to hide echo area container." + (when (exwm--terminal-p) + (unless (active-minibuffer-window) + (exwm-workspace--hide-minibuffer)) + (when exwm-workspace--display-echo-area-timer + (cancel-timer exwm-workspace--display-echo-area-timer) + (setq exwm-workspace--display-echo-area-timer nil)))) + +(defun exwm-workspace--set-desktop-geometry () + "Set _NET_DESKTOP_GEOMETRY." + (exwm--log) + ;; We don't support large desktop so it's the same with screen size. + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_DESKTOP_GEOMETRY + :window exwm--root + :width (x-display-pixel-width) + :height (x-display-pixel-height)))) + +(defun exwm-workspace--add-frame-as-workspace (frame) + "Configure frame FRAME to be treated as a workspace." + (exwm--log "%s" frame) + (setq exwm-workspace--list (nconc exwm-workspace--list (list frame))) + (let ((outer-id (string-to-number (frame-parameter frame + 'outer-window-id))) + (window-id (string-to-number (frame-parameter frame 'window-id))) + (container (xcb:generate-id exwm--connection)) + frame-colormap frame-visual frame-depth) + ;; Save window IDs + (set-frame-parameter frame 'exwm-outer-id outer-id) + (set-frame-parameter frame 'exwm-id window-id) + (set-frame-parameter frame 'exwm-container container) + ;; Copy RandR frame parameters from the first workspace to + ;; prevent potential problems. The values do not matter here as + ;; they'll be updated by the RandR module later. + (let ((w (car exwm-workspace--list))) + (dolist (param '(exwm-randr-monitor + exwm-geometry)) + (set-frame-parameter frame param (frame-parameter w param)))) + ;; Support transparency on the container X window when the Emacs frame + ;; does. Note that in addition to setting the visual, colormap and depth + ;; we must also reset the `:border-pixmap', as its default value is + ;; relative to the parent window, which might have a different depth. + (let* ((vdc (exwm--get-visual-depth-colormap exwm--connection outer-id))) + (setq frame-visual (car vdc)) + (setq frame-depth (cadr vdc)) + (setq frame-colormap (caddr vdc))) + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth frame-depth + :wid container + :parent exwm--root + :x -1 + :y -1 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOutput + :visual frame-visual + :value-mask (logior xcb:CW:BackPixmap + xcb:CW:BorderPixel + xcb:CW:Colormap + xcb:CW:OverrideRedirect) + :background-pixmap xcb:BackPixmap:None + :border-pixel 0 + :colormap frame-colormap + :override-redirect 1)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window container + :value-mask xcb:ConfigWindow:StackMode + :stack-mode xcb:StackMode:Below)) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window container + :data + (format "EXWM workspace %d frame container" + (exwm-workspace--position frame)))) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window outer-id :parent container :x 0 :y 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:icccm:set-WM_STATE + :window outer-id + :state xcb:icccm:WM_STATE:NormalState + :icon xcb:Window:None)) + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window container))) + (xcb:flush exwm--connection) + ;; Delay making the workspace fullscreen until Emacs becomes idle + (exwm--defer 0 #'exwm-workspace--fullscreen-workspace frame) + ;; Update EWMH properties. + (exwm-workspace--update-ewmh-props) + (if exwm-workspace--create-silently + (setq exwm-workspace--switch-history-outdated t) + (let ((original-index exwm-workspace-current-index)) + (exwm-workspace-switch frame t) + (message "Created %s as workspace %d; switched from %d" + frame exwm-workspace-current-index original-index)) + (run-hooks 'exwm-workspace-list-change-hook))) + +(defun exwm-workspace--get-next-workspace (frame) + "Return the next workspace if workspace FRAME were removed. +Return nil if FRAME is the only workspace." + (let* ((index (exwm-workspace--position frame)) + (lastp (= index (1- (exwm-workspace--count)))) + (nextw (elt exwm-workspace--list (+ index (if lastp -1 +1))))) + (unless (eq frame nextw) + nextw))) + +(defun exwm-workspace--remove-frame-as-workspace (frame &optional quit) + "Stop treating FRAME as a workspace. +When QUIT is non-nil cleanup avoid communicating with the X server." + ;; TODO: restore all frame parameters (e.g. exwm-workspace, buffer-predicate, + ;; etc) + (exwm--log "Removing frame `%s' as workspace" frame) + (unless quit + (let* ((next-frame (exwm-workspace--get-next-workspace frame)) + (following-frames (cdr (memq frame exwm-workspace--list)))) + ;; Need to remove the workspace from the list for the correct calculation of + ;; indexes below. + (setq exwm-workspace--list (delete frame exwm-workspace--list)) + ;; Move the windows to the next workspace and switch to it. + (unless next-frame + ;; The user managed to delete the last workspace, so create a new one. + (exwm--log "Last workspace deleted; create a new one") + (let ((exwm-workspace--create-silently t)) + (setq next-frame (make-frame)))) + (dolist (pair exwm--id-buffer-alist) + (let ((other-frame (buffer-local-value 'exwm--frame (cdr pair)))) + ;; Move X windows to next-frame. + (when (eq other-frame frame) + (exwm-workspace-move-window next-frame (car pair))) + ;; Update the _NET_WM_DESKTOP property of each following X window. + (when (memq other-frame following-frames) + (exwm-workspace--set-desktop (car pair))))) + ;; If the current workspace is deleted, switch to next one. + (when (eq frame exwm-workspace--current) + (exwm-workspace-switch next-frame)))) + ;; Reparent out the frame. + (let ((outer-id (frame-parameter frame 'exwm-outer-id))) + (xcb:+request exwm--connection + (make-instance 'xcb:UnmapWindow + :window outer-id)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window outer-id + :parent exwm--root + :x 0 + :y 0)) + ;; Reset the override-redirect. + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window outer-id + :value-mask xcb:CW:OverrideRedirect + :override-redirect 0)) + ;; Remove fullscreen state. + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_STATE + :window outer-id + :data nil)) + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow + :window outer-id))) + ;; Destroy the container. + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow + :window (frame-parameter frame 'exwm-container))) + (xcb:flush exwm--connection) + ;; Update EWMH properties. + (exwm-workspace--update-ewmh-props) + ;; Update switch history. + (unless quit + (setq exwm-workspace--switch-history-outdated t) + (run-hooks 'exwm-workspace-list-change-hook))) + +(defun exwm-workspace--on-delete-frame (frame) + "Hook run upon `delete-frame' removing FRAME as a workspace." + (cond + ((not (exwm-workspace--workspace-p frame)) + (exwm--log "Frame `%s' is not a workspace" frame)) + (t + (exwm-workspace--remove-frame-as-workspace frame)))) + +(defun exwm-workspace--fullscreen-workspace (frame) + "Make workspace FRAME fullscreen. +Called from a timer." + (when (frame-live-p frame) + (set-frame-parameter frame 'fullscreen 'fullboth))) + +(defun exwm-workspace--on-after-make-frame (frame) + "Hook run upon `make-frame' that configures FRAME as a workspace." + (cond + ((exwm-workspace--workspace-p frame) + (exwm--log "Frame `%s' is already a workspace" frame)) + ((not (display-graphic-p frame)) + (exwm--log "Frame `%s' is not graphical" frame)) + ((not (eq (frame-terminal) exwm--terminal)) + (exwm--log "Frame `%s' is on a different terminal (%S instead of %S)" + frame + (frame-terminal frame) + exwm--terminal)) + ((not (string-equal + (replace-regexp-in-string "\\.0$" "" + (slot-value exwm--connection 'display)) + (replace-regexp-in-string "\\.0$" "" + (frame-parameter frame 'display)))) + (exwm--log "Frame `%s' is on a different DISPLAY (%S instead of %S)" + frame + (frame-parameter frame 'display) + (slot-value exwm--connection 'display))) + ((frame-parameter frame 'unsplittable) + ;; We create floating frames with the "unsplittable" parameter set. + ;; Though it may not be a floating frame, we won't treat an + ;; unsplittable frame as a workspace anyway. + (exwm--log "Frame `%s' is floating" frame)) + (t + (exwm--log "Adding frame `%s' as workspace" frame) + (exwm-workspace--add-frame-as-workspace frame)))) + +(defun exwm-workspace--update-ewmh-props () + "Update EWMH properties to match the workspace list." + (exwm--log) + (let ((num-workspaces (exwm-workspace--count))) + ;; Avoid setting 0 desktops. + (when (= 0 num-workspaces) + (setq num-workspaces 1)) + ;; Set _NET_NUMBER_OF_DESKTOPS. + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS + :window exwm--root :data num-workspaces)) + ;; Set _NET_DESKTOP_GEOMETRY. + (exwm-workspace--set-desktop-geometry) + ;; Update workareas. + (exwm-workspace--update-workareas)) + (xcb:flush exwm--connection)) + +(defun exwm-workspace--modify-all-x-frames-parameters (new-x-parameters) + "Modifies `window-system-default-frame-alist' for the X Window System. +NEW-X-PARAMETERS is an alist of frame parameters, merged into current +`window-system-default-frame-alist' for the X Window System. The parameters are +applied to all subsequently created X frames." + (exwm--log) + ;; The parameters are modified in place; take current + ;; ones or insert a new X-specific list. + (let ((x-parameters (or (assq 'x window-system-default-frame-alist) + (let ((new-x-parameters '(x))) + (push new-x-parameters + window-system-default-frame-alist) + new-x-parameters)))) + (setf (cdr x-parameters) + (append new-x-parameters (cdr x-parameters))))) + +(defun exwm-workspace--handle-focus-in (_orig-func _event) + "Replacement for `handle-focus-in'." + (interactive "e")) + +(defun exwm-workspace--handle-focus-out (_orig-func _event) + "Replacement for `handle-focus-out'." + (interactive "e")) + +(defun exwm-workspace--init-minibuffer-frame () + "Initialize minibuffer-only frame." + (exwm--log) + ;; Initialize workspaces without minibuffers. + (setq exwm-workspace--minibuffer + (make-frame '((window-system . x) (minibuffer . only) + (left . 10000) (right . 10000) + (width . 1) (height . 1)))) + ;; This is the only usable minibuffer frame. + (setq default-minibuffer-frame exwm-workspace--minibuffer) + (exwm-workspace--modify-all-x-frames-parameters + '((minibuffer . nil))) + (let ((outer-id (string-to-number + (frame-parameter exwm-workspace--minibuffer + 'outer-window-id))) + (window-id (string-to-number + (frame-parameter exwm-workspace--minibuffer + 'window-id))) + (container (xcb:generate-id exwm--connection))) + (set-frame-parameter exwm-workspace--minibuffer + 'exwm-outer-id outer-id) + (set-frame-parameter exwm-workspace--minibuffer 'exwm-id window-id) + (set-frame-parameter exwm-workspace--minibuffer 'exwm-container + container) + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid container + :parent exwm--root + :x 0 + :y 0 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOutput + :visual 0 + :value-mask (logior xcb:CW:BackPixmap + xcb:CW:OverrideRedirect) + :background-pixmap xcb:BackPixmap:ParentRelative + :override-redirect 1)) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window container + :data "EXWM minibuffer container")) + ;; Reparent the minibuffer frame to the container. + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window outer-id :parent container :x 0 :y 0)) + ;; Map the container. + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow + :window container)) + ;; Attach event listener for monitoring the frame + (xcb:+request exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window outer-id + :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:StructureNotify)) + (xcb:+event exwm--connection 'xcb:ConfigureNotify + #'exwm-workspace--on-ConfigureNotify)) + ;; Show/hide minibuffer / echo area when they're active/inactive. + (add-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup) + (add-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) + (setq exwm-workspace--timer + (run-with-idle-timer 0 t #'exwm-workspace--on-echo-area-dirty)) + (add-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) + ;; The default behavior of `display-buffer' (indirectly called by + ;; `minibuffer-completion-help') is not correct here. + (cl-pushnew '(exwm-workspace--display-buffer) display-buffer-alist + :test #'equal)) + +(defun exwm-workspace--exit-minibuffer-frame () + "Cleanup minibuffer-only frame." + (exwm--log) + ;; Only on minibuffer-frame. + (remove-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup) + (remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) + (remove-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) + (when exwm-workspace--display-echo-area-timer + (cancel-timer exwm-workspace--display-echo-area-timer)) + (when exwm-workspace--timer + (cancel-timer exwm-workspace--timer) + (setq exwm-workspace--timer nil)) + (setq display-buffer-alist + (cl-delete '(exwm-workspace--display-buffer) display-buffer-alist + :test #'equal)) + (setq default-minibuffer-frame nil) + (when (frame-live-p exwm-workspace--minibuffer) ; might be already dead + (let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id))) + (when (and exwm-workspace--minibuffer id + ;; Invoked from `exwm-manage--exit' upon disconnection. + (slot-value exwm--connection 'connected)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window id + :parent exwm--root + :x 0 + :y 0))) + (setq exwm-workspace--minibuffer nil)))) + +(defun exwm-workspace--init () + "Initialize workspace module." + (exwm--log) + (exwm-workspace--init-switch-map) + ;; Prevent unexpected exit + (setq exwm-workspace--fullscreen-frame-count 0) + (exwm-workspace--modify-all-x-frames-parameters + '((internal-border-width . 0))) + (let ((initial-workspaces (frame-list))) + (if (not (exwm-workspace--minibuffer-own-frame-p)) + ;; Initialize workspaces with minibuffers. + (when (< 1 (length initial-workspaces)) + ;; Exclude the initial frame. + (dolist (i initial-workspaces) + (unless (frame-parameter i 'window-id) + (setq initial-workspaces (delq i initial-workspaces)))) + (let ((f (car initial-workspaces))) + ;; Remove the possible internal border. + (set-frame-parameter f 'internal-border-width 0))) + (exwm-workspace--init-minibuffer-frame) + ;; Remove/hide existing frames. + (dolist (f initial-workspaces) + (when (eq 'x (framep f)) ;do not delete the initial frame. + (delete-frame f))) + ;; Recreate one frame with the external minibuffer set. + (setq initial-workspaces (list (make-frame '((window-system . x)))))) + ;; Prevent `other-buffer' from selecting already displayed EXWM buffers. + (modify-all-frames-parameters + '((buffer-predicate . exwm-layout--other-buffer-predicate))) + ;; Create remaining workspaces. + (dotimes (_ (- exwm-workspace-number (length initial-workspaces))) + (nconc initial-workspaces (list (make-frame '((window-system . x)))))) + ;; Configure workspaces + (let ((exwm-workspace--create-silently t)) + (dolist (i initial-workspaces) + (exwm-workspace--add-frame-as-workspace i)))) + (xcb:flush exwm--connection) + ;; We have to advice `x-create-frame' or every call to it would hang EXWM + (advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame) + ;; We have to manually handle focus-in and focus-out events for Emacs + ;; frames. + (advice-add 'handle-focus-in :around #'exwm-workspace--handle-focus-in) + (advice-add 'handle-focus-out :around #'exwm-workspace--handle-focus-out) + ;; Make new frames create new workspaces. + (add-hook 'after-make-frame-functions + #'exwm-workspace--on-after-make-frame) + (add-hook 'delete-frame-functions #'exwm-workspace--on-delete-frame) + (when (exwm-workspace--minibuffer-own-frame-p) + (add-hook 'exwm-input--event-hook + #'exwm-workspace--on-echo-area-clear)) + ;; Switch to the first workspace + (exwm-workspace-switch 0 t) + ;; Prevent frame parameters introduced by this module from being + ;; saved/restored. + (dolist (i '(exwm-active exwm-outer-id exwm-id exwm-container exwm-geometry + exwm-selected-window exwm-urgency fullscreen)) + (unless (assq i frameset-filter-alist) + (push (cons i :never) frameset-filter-alist)))) + +(defun exwm-workspace--exit () + "Exit the workspace module." + (exwm--log) + (when (exwm-workspace--minibuffer-own-frame-p) + (exwm-workspace--exit-minibuffer-frame)) + (advice-remove 'x-create-frame #'exwm-workspace--x-create-frame) + (advice-remove 'handle-focus-in #'exwm-workspace--handle-focus-in) + (advice-remove 'handle-focus-out #'exwm-workspace--handle-focus-out) + (remove-hook 'after-make-frame-functions + #'exwm-workspace--on-after-make-frame) + (remove-hook 'delete-frame-functions + #'exwm-workspace--on-delete-frame) + (when (exwm-workspace--minibuffer-own-frame-p) + (remove-hook 'exwm-input--event-hook + #'exwm-workspace--on-echo-area-clear)) + ;; Hide & reparent out all frames (save-set can't be used here since + ;; X windows will be re-mapped). + (when (slot-value exwm--connection 'connected) + (dolist (i exwm-workspace--list) + (when (frame-live-p i) ; might be already dead + (exwm-workspace--remove-frame-as-workspace i 'quit) + (modify-frame-parameters i '((exwm-selected-window . nil) + (exwm-urgency . nil) + (exwm-outer-id . nil) + (exwm-id . nil) + (exwm-container . nil) + ;; (internal-border-width . nil) ; integerp + (fullscreen . nil) + (buffer-predicate . nil)))))) + ;; Don't let dead frames linger. + (setq exwm-workspace--current nil) + (setq exwm-workspace-current-index 0) + (setq exwm-workspace--list nil)) + +(defun exwm-workspace--post-init () + "The second stage in the initialization of the workspace module." + (exwm--log) + ;; Wait until all workspace frames are resized. + (with-timeout (1) + (while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count)) + (accept-process-output nil 0.1))) + (setq exwm-workspace--fullscreen-frame-count nil)) + + + +(provide 'exwm-workspace) + +;;; exwm-workspace.el ends here diff --git a/third_party/exwm/exwm-xim.el b/third_party/exwm/exwm-xim.el new file mode 100644 index 000000000000..1f0c9c460ba5 --- /dev/null +++ b/third_party/exwm/exwm-xim.el @@ -0,0 +1,810 @@ +;;; exwm-xim.el --- XIM Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module adds XIM support for EXWM and allows sending characters +;; generated by any Emacs's builtin input method (info node `Input Methods') +;; to X windows. + +;; This module is essentially an X input method server utilizing Emacs as +;; its backend. It talks with X windows through the XIM protocol. The XIM +;; protocol is quite flexible by itself, stating that an implementation can +;; create network connections of various types as well as make use of an +;; existing X connection for communication, and that an IM server may +;; support multiple transport versions, various input styles and several +;; event flow modals, etc. Here we only make choices that are most popular +;; among other IM servers and more importantly, practical for Emacs to act +;; as an IM server: +;; +;; + Packets are transported on top of an X connection like most IMEs. +;; + Only transport version 0.0 (i.e. only-CM & Property-with-CM) is +;; supported (same as "IM Server Developers Kit", adopted by most IMEs). +;; + Only support static event flow, on-demand-synchronous method. +;; + Only "root-window" input style is supported. + +;; To use this module, first load and enable it as follows: +;; +;; (require 'exwm-xim) +;; (exwm-xim-enable) +;; +;; A keybinding for `toggle-input-method' is probably required to turn on & +;; off an input method (default to `default-input-method'). It's bound to +;; 'C-\' by default and can be made reachable when working with X windows: +;; +;; (push ?\C-\\ exwm-input-prefix-keys) +;; +;; It's also required (and error-prone) to setup environment variables to +;; make applications actually use this input method. Typically the +;; following lines should be inserted into '~/.xinitrc'. +;; +;; export XMODIFIERS=@im=exwm-xim +;; export GTK_IM_MODULE=xim +;; export QT_IM_MODULE=xim +;; export CLUTTER_IM_MODULE=xim + +;; References: +;; + XIM (http://www.x.org/releases/X11R7.6/doc/libX11/specs/XIM/xim.html) +;; + IMdkit (http://xorg.freedesktop.org/archive/unsupported/lib/IMdkit/) +;; + UIM (https://github.com/uim/uim) + +;;; Code: + +(require 'cl-lib) + +(require 'xcb-keysyms) +(require 'xcb-xim) + +(require 'exwm-core) +(require 'exwm-input) + +(defconst exwm-xim--locales + "@locale=\ +aa,af,ak,am,an,anp,ar,as,ast,ayc,az,be,bem,ber,bg,bhb,bho,bn,bo,br,brx,bs,byn,\ +ca,ce,cmn,crh,cs,csb,cv,cy,da,de,doi,dv,dz,el,en,es,et,eu,fa,ff,fi,fil,fo,fr,\ +fur,fy,ga,gd,gez,gl,gu,gv,ha,hak,he,hi,hne,hr,hsb,ht,hu,hy,ia,id,ig,ik,is,it,\ +iu,iw,ja,ka,kk,kl,km,kn,ko,kok,ks,ku,kw,ky,lb,lg,li,li,lij,lo,lt,lv,lzh,mag,\ +mai,mg,mhr,mi,mk,ml,mn,mni,mr,ms,mt,my,nan,nb,nds,ne,nhn,niu,nl,nn,nr,nso,oc,\ +om,or,os,pa,pa,pap,pl,ps,pt,quz,raj,ro,ru,rw,sa,sat,sc,sd,se,shs,si,sid,sk,sl,\ +so,sq,sr,ss,st,sv,sw,szl,ta,tcy,te,tg,th,the,ti,tig,tk,tl,tn,tr,ts,tt,ug,uk,\ +unm,ur,uz,ve,vi,wa,wae,wal,wo,xh,yi,yo,yue,zh,zu,\ +C,no" + "All supported locales (stolen from glibc).") + +(defconst exwm-xim--default-error + (make-instance 'xim:error + :im-id 0 + :ic-id 0 + :flag xim:error-flag:invalid-both + :error-code xim:error-code:bad-something + :length 0 + :type 0 + :detail nil) + "Default error returned to clients.") + +(defconst exwm-xim--default-im-attrs + (list (make-instance 'xim:XIMATTR + :id 0 + :type xim:ATTRIBUTE-VALUE-TYPE:xim-styles + :length (length xlib:XNQueryInputStyle) + :attribute xlib:XNQueryInputStyle)) + "Default IM attrs returned to clients.") + +(defconst exwm-xim--default-ic-attrs + (list (make-instance 'xim:XICATTR + :id 0 + :type xim:ATTRIBUTE-VALUE-TYPE:long-data + :length (length xlib:XNInputStyle) + :attribute xlib:XNInputStyle) + (make-instance 'xim:XICATTR + :id 1 + :type xim:ATTRIBUTE-VALUE-TYPE:window + :length (length xlib:XNClientWindow) + :attribute xlib:XNClientWindow) + ;; Required by e.g. xterm. + (make-instance 'xim:XICATTR + :id 2 + :type xim:ATTRIBUTE-VALUE-TYPE:window + :length (length xlib:XNFocusWindow) + :attribute xlib:XNFocusWindow)) + "Default IC attrs returned to clients.") + +(defconst exwm-xim--default-styles + (make-instance 'xim:XIMStyles + :number nil + :styles (list (logior xlib:XIMPreeditNothing + xlib:XIMStatusNothing))) + "Default styles: root-window, i.e. no preediting or status display support.") + +(defconst exwm-xim--default-attributes + (list (make-instance 'xim:XIMATTRIBUTE + :id 0 + :length nil + :value exwm-xim--default-styles)) + "Default IM/IC attributes returned to clients.") + +(defvar exwm-xim--conn nil + "The X connection for initiating other XIM connections.") +(defvar exwm-xim--event-xwin nil + "X window for initiating new XIM connections.") +(defvar exwm-xim--server-client-plist '(nil nil) + "Plist mapping server window to [X connection, client window, byte-order].") +(defvar exwm-xim--client-server-plist '(nil nil) + "Plist mapping client window to server window.") +(defvar exwm-xim--property-index 0 "For generating a unique property name.") +(defvar exwm-xim--im-id 0 "Last IM ID.") +(defvar exwm-xim--ic-id 0 "Last IC ID.") + +;; X11 atoms. +(defvar exwm-xim--@server nil) +(defvar exwm-xim--LOCALES nil) +(defvar exwm-xim--TRANSPORT nil) +(defvar exwm-xim--XIM_SERVERS nil) +(defvar exwm-xim--_XIM_PROTOCOL nil) +(defvar exwm-xim--_XIM_XCONNECT nil) + +(defvar exwm-xim-buffer-p nil + "Whether current buffer is used by exwm-xim.") +(make-variable-buffer-local 'exwm-xim-buffer-p) + +(defun exwm-xim--on-SelectionRequest (data _synthetic) + "Handle SelectionRequest events on IMS window. +DATA contains unmarshalled SelectionRequest event data. + +Such events would be received when clients query for LOCALES or TRANSPORT." + (exwm--log) + (let ((evt (make-instance 'xcb:SelectionRequest)) + value fake-event) + (xcb:unmarshal evt data) + (with-slots (time requestor selection target property) evt + (setq value (cond ((= target exwm-xim--LOCALES) + ;; Return supported locales. + exwm-xim--locales) + ((= target exwm-xim--TRANSPORT) + ;; Use XIM over an X connection. + "@transport=X/"))) + (when value + ;; Change the property. + (xcb:+request exwm-xim--conn + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Replace + :window requestor + :property property + :type target + :format 8 + :data-len (length value) + :data value)) + ;; Send a SelectionNotify event. + (setq fake-event (make-instance 'xcb:SelectionNotify + :time time + :requestor requestor + :selection selection + :target target + :property property)) + (xcb:+request exwm-xim--conn + (make-instance 'xcb:SendEvent + :propagate 0 + :destination requestor + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal fake-event exwm-xim--conn))) + (xcb:flush exwm-xim--conn))))) + +(cl-defun exwm-xim--on-ClientMessage-0 (data _synthetic) + "Handle ClientMessage event on IMS window (new connection). + +Such events would be received when clients request for _XIM_XCONNECT. +A new X connection and server window would be created to communicate with +this client." + (exwm--log) + (let ((evt (make-instance 'xcb:ClientMessage)) + conn client-xwin server-xwin) + (xcb:unmarshal evt data) + (with-slots (window type data) evt + (unless (= type exwm-xim--_XIM_XCONNECT) + ;; Only handle _XIM_XCONNECT. + (exwm--log "Ignore ClientMessage %s" type) + (cl-return-from exwm-xim--on-ClientMessage-0)) + (setq client-xwin (elt (slot-value data 'data32) 0) + ;; Create a new X connection and a new server window. + conn (xcb:connect) + server-xwin (xcb:generate-id conn)) + (set-process-query-on-exit-flag (slot-value conn 'process) nil) + ;; Store this client. + (plist-put exwm-xim--server-client-plist server-xwin + `[,conn ,client-xwin nil]) + (plist-put exwm-xim--client-server-plist client-xwin server-xwin) + ;; Select DestroyNotify events on this client window. + (xcb:+request exwm-xim--conn + (make-instance 'xcb:ChangeWindowAttributes + :window client-xwin + :value-mask xcb:CW:EventMask + :event-mask xcb:EventMask:StructureNotify)) + (xcb:flush exwm-xim--conn) + ;; Handle ClientMessage events from this new connection. + (xcb:+event conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage) + ;; Create a communication window. + (xcb:+request conn + (make-instance 'xcb:CreateWindow + :depth 0 + :wid server-xwin + :parent exwm--root + :x 0 + :y 0 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOutput + :visual 0 + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + (xcb:flush conn) + ;; Send connection establishment ClientMessage. + (setf window client-xwin + (slot-value data 'data32) `(,server-xwin 0 0 0 0)) + (slot-makeunbound data 'data8) + (slot-makeunbound data 'data16) + (xcb:+request exwm-xim--conn + (make-instance 'xcb:SendEvent + :propagate 0 + :destination client-xwin + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal evt exwm-xim--conn))) + (xcb:flush exwm-xim--conn)))) + +(cl-defun exwm-xim--on-ClientMessage (data _synthetic) + "Handle ClientMessage event on IMS communication window (request). + +Such events would be received when clients request for _XIM_PROTOCOL. +The actual XIM request is in client message data or a property." + (exwm--log) + (let ((evt (make-instance 'xcb:ClientMessage)) + conn client-xwin server-xwin) + (xcb:unmarshal evt data) + (with-slots (format window type data) evt + (unless (= type exwm-xim--_XIM_PROTOCOL) + (exwm--log "Ignore ClientMessage %s" type) + (cl-return-from exwm-xim--on-ClientMessage)) + (setq server-xwin window + conn (plist-get exwm-xim--server-client-plist server-xwin) + client-xwin (elt conn 1) + conn (elt conn 0)) + (cond ((= format 8) + ;; Data. + (exwm-xim--on-request (vconcat (slot-value data 'data8)) + conn client-xwin server-xwin)) + ((= format 32) + ;; Atom. + (with-slots (data32) data + (with-slots (value) + (xcb:+request-unchecked+reply conn + (make-instance 'xcb:GetProperty + :delete 1 + :window server-xwin + :property (elt data32 1) + :type xcb:GetPropertyType:Any + :long-offset 0 + :long-length (elt data32 0))) + (when (> (length value) 0) + (exwm-xim--on-request value conn client-xwin + server-xwin))))))))) + +(defun exwm-xim--on-request (data conn client-xwin server-xwin) + "Handle an XIM reuqest." + (exwm--log) + (let ((opcode (elt data 0)) + ;; Let-bind `xim:lsb' to make pack/unpack functions work correctly. + (xim:lsb (elt (plist-get exwm-xim--server-client-plist server-xwin) 2)) + req replies) + (cond ((= opcode xim:opcode:error) + (exwm--log "ERROR: %s" data)) + ((= opcode xim:opcode:connect) + (exwm--log "CONNECT") + (setq xim:lsb (= (elt data 4) xim:connect-byte-order:lsb-first)) + ;; Store byte-order. + (setf (elt (plist-get exwm-xim--server-client-plist server-xwin) 2) + xim:lsb) + (setq req (make-instance 'xim:connect)) + (xcb:unmarshal req data) + (if (and (= (slot-value req 'major-version) 1) + (= (slot-value req 'minor-version) 0) + ;; Do not support authentication. + (= (slot-value req 'number) 0)) + ;; Accept the connection. + (push (make-instance 'xim:connect-reply) replies) + ;; Deny it. + (push exwm-xim--default-error replies))) + ((memq opcode (list xim:opcode:auth-required + xim:opcode:auth-reply + xim:opcode:auth-next + xim:opcode:auth-ng)) + (exwm--log "AUTH: %d" opcode) + ;; Deny any attempt to make authentication. + (push exwm-xim--default-error replies)) + ((= opcode xim:opcode:disconnect) + (exwm--log "DISCONNECT") + ;; Gracefully disconnect from the client. + (exwm-xim--make-request (make-instance 'xim:disconnect-reply) + conn client-xwin) + ;; Destroy the communication window & connection. + (xcb:+request conn + (make-instance 'xcb:DestroyWindow + :window server-xwin)) + (xcb:disconnect conn) + ;; Clean up cache. + (cl-remf exwm-xim--server-client-plist server-xwin) + (cl-remf exwm-xim--client-server-plist client-xwin)) + ((= opcode xim:opcode:open) + (exwm--log "OPEN") + ;; Note: We make no check here. + (setq exwm-xim--im-id (if (< exwm-xim--im-id #xffff) + (1+ exwm-xim--im-id) + 1)) + (setq replies + (list + (make-instance 'xim:open-reply + :im-id exwm-xim--im-id + :im-attrs-length nil + :im-attrs exwm-xim--default-im-attrs + :ic-attrs-length nil + :ic-attrs exwm-xim--default-ic-attrs) + (make-instance 'xim:set-event-mask + :im-id exwm-xim--im-id + :ic-id 0 + ;; Static event flow. + :forward-event-mask xcb:EventMask:KeyPress + ;; on-demand-synchronous method. + :synchronous-event-mask + xcb:EventMask:NoEvent)))) + ((= opcode xim:opcode:close) + (exwm--log "CLOSE") + (setq req (make-instance 'xim:close)) + (xcb:unmarshal req data) + (push (make-instance 'xim:close-reply + :im-id (slot-value req 'im-id)) + replies)) + ((= opcode xim:opcode:trigger-notify) + (exwm--log "TRIGGER-NOTIFY") + ;; Only static event flow modal is supported. + (push exwm-xim--default-error replies)) + ((= opcode xim:opcode:encoding-negotiation) + (exwm--log "ENCODING-NEGOTIATION") + (setq req (make-instance 'xim:encoding-negotiation)) + (xcb:unmarshal req data) + (let ((index (cl-position "COMPOUND_TEXT" + (mapcar (lambda (i) (slot-value i 'name)) + (slot-value req 'names)) + :test #'equal))) + (unless index + ;; Fallback to portable character encoding (a subset of ASCII). + (setq index -1)) + (push (make-instance 'xim:encoding-negotiation-reply + :im-id (slot-value req 'im-id) + :category + xim:encoding-negotiation-reply-category:name + :index index) + replies))) + ((= opcode xim:opcode:query-extension) + (exwm--log "QUERY-EXTENSION") + (setq req (make-instance 'xim:query-extension)) + (xcb:unmarshal req data) + (push (make-instance 'xim:query-extension-reply + :im-id (slot-value req 'im-id) + ;; No extension support. + :length 0 + :extensions nil) + replies)) + ((= opcode xim:opcode:set-im-values) + (exwm--log "SET-IM-VALUES") + ;; There's only one possible input method attribute. + (setq req (make-instance 'xim:set-im-values)) + (xcb:unmarshal req data) + (push (make-instance 'xim:set-im-values-reply + :im-id (slot-value req 'im-id)) + replies)) + ((= opcode xim:opcode:get-im-values) + (exwm--log "GET-IM-VALUES") + (setq req (make-instance 'xim:get-im-values)) + (let (im-attributes-id) + (xcb:unmarshal req data) + (setq im-attributes-id (slot-value req 'im-attributes-id)) + (if (cl-notevery (lambda (i) (= i 0)) im-attributes-id) + ;; Only support one IM attributes. + (push (make-instance 'xim:error + :im-id (slot-value req 'im-id) + :ic-id 0 + :flag xim:error-flag:invalid-ic-id + :error-code xim:error-code:bad-something + :length 0 + :type 0 + :detail nil) + replies) + (push + (make-instance 'xim:get-im-values-reply + :im-id (slot-value req 'im-id) + :length nil + :im-attributes exwm-xim--default-attributes) + replies)))) + ((= opcode xim:opcode:create-ic) + (exwm--log "CREATE-IC") + (setq req (make-instance 'xim:create-ic)) + (xcb:unmarshal req data) + ;; Note: The ic-attributes slot is ignored. + (setq exwm-xim--ic-id (if (< exwm-xim--ic-id #xffff) + (1+ exwm-xim--ic-id) + 1)) + (push (make-instance 'xim:create-ic-reply + :im-id (slot-value req 'im-id) + :ic-id exwm-xim--ic-id) + replies)) + ((= opcode xim:opcode:destroy-ic) + (exwm--log "DESTROY-IC") + (setq req (make-instance 'xim:destroy-ic)) + (xcb:unmarshal req data) + (push (make-instance 'xim:destroy-ic-reply + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id)) + replies)) + ((= opcode xim:opcode:set-ic-values) + (exwm--log "SET-IC-VALUES") + (setq req (make-instance 'xim:set-ic-values)) + (xcb:unmarshal req data) + ;; We don't distinguish between input contexts. + (push (make-instance 'xim:set-ic-values-reply + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id)) + replies)) + ((= opcode xim:opcode:get-ic-values) + (exwm--log "GET-IC-VALUES") + (setq req (make-instance 'xim:get-ic-values)) + (xcb:unmarshal req data) + (push (make-instance 'xim:get-ic-values-reply + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id) + :length nil + :ic-attributes exwm-xim--default-attributes) + replies)) + ((= opcode xim:opcode:set-ic-focus) + (exwm--log "SET-IC-FOCUS") + ;; All input contexts are the same. + ) + ((= opcode xim:opcode:unset-ic-focus) + (exwm--log "UNSET-IC-FOCUS") + ;; All input contexts are the same. + ) + ((= opcode xim:opcode:forward-event) + (exwm--log "FORWARD-EVENT") + (setq req (make-instance 'xim:forward-event)) + (xcb:unmarshal req data) + (exwm-xim--handle-forward-event-request req xim:lsb conn + client-xwin)) + ((= opcode xim:opcode:sync) + (exwm--log "SYNC") + (setq req (make-instance 'xim:sync)) + (xcb:unmarshal req data) + (push (make-instance 'xim:sync-reply + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id)) + replies)) + ((= opcode xim:opcode:sync-reply) + (exwm--log "SYNC-REPLY")) + ((= opcode xim:opcode:reset-ic) + (exwm--log "RESET-IC") + ;; No context-specific data saved. + (setq req (make-instance 'xim:reset-ic)) + (xcb:unmarshal req data) + (push (make-instance 'xim:reset-ic-reply + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id) + :length 0 + :string "") + replies)) + ((memq opcode (list xim:opcode:str-conversion-reply + xim:opcode:preedit-start-reply + xim:opcode:preedit-caret-reply)) + (exwm--log "PREEDIT: %d" opcode) + ;; No preedit support. + (push exwm-xim--default-error replies)) + (t + (exwm--log "Bad protocol") + (push exwm-xim--default-error replies))) + ;; Actually send the replies. + (when replies + (mapc (lambda (reply) + (exwm-xim--make-request reply conn client-xwin)) + replies) + (xcb:flush conn)))) + +(defun exwm-xim--handle-forward-event-request (req lsb conn client-xwin) + (let ((im-func (with-current-buffer (window-buffer) + input-method-function)) + key-event keysym keysyms event result) + ;; Note: The flag slot is ignored. + ;; Do conversion in client's byte-order. + (let ((xcb:lsb lsb)) + (setq key-event (make-instance 'xcb:KeyPress)) + (xcb:unmarshal key-event (slot-value req 'event))) + (with-slots (detail state) key-event + (setq keysym (xcb:keysyms:keycode->keysym exwm-xim--conn detail + state)) + (when (/= (car keysym) 0) + (setq event (xcb:keysyms:keysym->event + exwm-xim--conn + (car keysym) + (logand state (lognot (cdr keysym))))))) + (while (or (slot-value req 'event) unread-command-events) + (unless (slot-value req 'event) + (setq event (pop unread-command-events)) + ;; Handle events in (t . EVENT) format. + (when (and (consp event) + (eq (car event) t)) + (setq event (cdr event)))) + (if (or (not im-func) + ;; `list' is the default method. + (eq im-func #'list) + (not event) + ;; Select only printable keys. + (not (integerp event)) (> #x20 event) (< #x7e event)) + ;; Either there is no active input method, or invalid key + ;; is detected. + (with-slots ((raw-event event) + im-id ic-id serial-number) + req + (if raw-event + (setq event raw-event) + (setq keysyms (xcb:keysyms:event->keysyms exwm-xim--conn event)) + (with-slots (detail state) key-event + (setf detail (xcb:keysyms:keysym->keycode exwm-xim--conn + (caar keysyms)) + state (cdar keysyms))) + (setq event (let ((xcb:lsb lsb)) + (xcb:marshal key-event conn)))) + (when event + (exwm-xim--make-request + (make-instance 'xim:forward-event + :im-id im-id + :ic-id ic-id + :flag xim:commit-flag:synchronous + :serial-number serial-number + :event event) + conn client-xwin))) + (when (eq exwm--selected-input-mode 'char-mode) + ;; Grab keyboard temporarily for char-mode. + (exwm-input--grab-keyboard)) + (unwind-protect + (with-temp-buffer + ;; This variable is used to test whether exwm-xim is enabled. + ;; Used by e.g. pyim-probe. + (setq-local exwm-xim-buffer-p t) + ;; Always show key strokes. + (let ((input-method-use-echo-area t) + (exwm-input-line-mode-passthrough t)) + (setq result (funcall im-func event)) + ;; Clear echo area for the input method. + (message nil) + ;; This also works for portable character encoding. + (setq result + (encode-coding-string (concat result) + 'compound-text-with-extensions)) + (exwm-xim--make-request + (make-instance 'xim:commit-x-lookup-chars + :im-id (slot-value req 'im-id) + :ic-id (slot-value req 'ic-id) + :flag (logior xim:commit-flag:synchronous + xim:commit-flag:x-lookup-chars) + :length (length result) + :string result) + conn client-xwin))) + (when (eq exwm--selected-input-mode 'char-mode) + (exwm-input--release-keyboard)))) + (xcb:flush conn) + (setf event nil + (slot-value req 'event) nil)))) + +(defun exwm-xim--make-request (req conn client-xwin) + "Make an XIM request REQ via connection CONN. + +CLIENT-XWIN would receive a ClientMessage event either telling the client +the request data or where to fetch the data." + (exwm--log) + (let ((data (xcb:marshal req)) + property format client-message-data client-message) + (if (<= (length data) 20) + ;; Send short requests directly with client messages. + (setq format 8 + ;; Pad to 20 bytes. + data (append data (make-list (- 20 (length data)) 0)) + client-message-data (make-instance 'xcb:ClientMessageData + :data8 data)) + ;; Send long requests with properties. + (setq property (exwm--intern-atom (format "_EXWM_XIM_%x" + exwm-xim--property-index))) + (cl-incf exwm-xim--property-index) + (xcb:+request conn + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Append + :window client-xwin + :property property + :type xcb:Atom:STRING + :format 8 + :data-len (length data) + :data data)) + ;; Also send a client message to notify the client about this property. + (setq format 32 + client-message-data (make-instance 'xcb:ClientMessageData + :data32 `(,(length data) + ,property + ;; Pad to 20 bytes. + 0 0 0)))) + ;; Send the client message. + (setq client-message (make-instance 'xcb:ClientMessage + :format format + :window client-xwin + :type exwm-xim--_XIM_PROTOCOL + :data client-message-data)) + (xcb:+request conn + (make-instance 'xcb:SendEvent + :propagate 0 + :destination client-xwin + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal client-message conn))))) + +(defun exwm-xim--on-DestroyNotify (data synthetic) + "Do cleanups on receiving DestroyNotify event. + +Such event would be received when the client window is destroyed." + (exwm--log) + (unless synthetic + (let ((evt (make-instance 'xcb:DestroyNotify)) + conn client-xwin server-xwin) + (xcb:unmarshal evt data) + (setq client-xwin (slot-value evt 'window) + server-xwin (plist-get exwm-xim--client-server-plist client-xwin)) + (when server-xwin + (setq conn (aref (plist-get exwm-xim--server-client-plist server-xwin) + 0)) + (cl-remf exwm-xim--server-client-plist server-xwin) + (cl-remf exwm-xim--client-server-plist client-xwin) + ;; Destroy the communication window & connection. + (xcb:+request conn + (make-instance 'xcb:DestroyWindow + :window server-xwin)) + (xcb:disconnect conn))))) + +(cl-defun exwm-xim--init () + "Initialize the XIM module." + (exwm--log) + (when exwm-xim--conn + (cl-return-from exwm-xim--init)) + ;; Initialize atoms. + (setq exwm-xim--@server (exwm--intern-atom "@server=exwm-xim") + exwm-xim--LOCALES (exwm--intern-atom "LOCALES") + exwm-xim--TRANSPORT (exwm--intern-atom "TRANSPORT") + exwm-xim--XIM_SERVERS (exwm--intern-atom "XIM_SERVERS") + exwm-xim--_XIM_PROTOCOL (exwm--intern-atom "_XIM_PROTOCOL") + exwm-xim--_XIM_XCONNECT (exwm--intern-atom "_XIM_XCONNECT")) + ;; Create a new connection and event window. + (setq exwm-xim--conn (xcb:connect) + exwm-xim--event-xwin (xcb:generate-id exwm-xim--conn)) + (set-process-query-on-exit-flag (slot-value exwm-xim--conn 'process) nil) + ;; Initialize xcb:keysyms module. + (xcb:keysyms:init exwm-xim--conn) + ;; Listen to SelectionRequest event for connection establishment. + (xcb:+event exwm-xim--conn 'xcb:SelectionRequest + #'exwm-xim--on-SelectionRequest) + ;; Listen to ClientMessage event on IMS window for new XIM connection. + (xcb:+event exwm-xim--conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage-0) + ;; Listen to DestroyNotify event to do cleanups. + (xcb:+event exwm-xim--conn 'xcb:DestroyNotify #'exwm-xim--on-DestroyNotify) + ;; Create the event window. + (xcb:+request exwm-xim--conn + (make-instance 'xcb:CreateWindow + :depth 0 + :wid exwm-xim--event-xwin + :parent exwm--root + :x 0 + :y 0 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOutput + :visual 0 + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + ;; Set the selection owner. + (xcb:+request exwm-xim--conn + (make-instance 'xcb:SetSelectionOwner + :owner exwm-xim--event-xwin + :selection exwm-xim--@server + :time xcb:Time:CurrentTime)) + ;; Set XIM_SERVERS property on the root window. + (xcb:+request exwm-xim--conn + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Prepend + :window exwm--root + :property exwm-xim--XIM_SERVERS + :type xcb:Atom:ATOM + :format 32 + :data-len 1 + :data (funcall (if xcb:lsb + #'xcb:-pack-u4-lsb + #'xcb:-pack-u4) + exwm-xim--@server))) + (xcb:flush exwm-xim--conn)) + +(cl-defun exwm-xim--exit () + "Exit the XIM module." + (exwm--log) + ;; Close IMS communication connections. + (mapc (lambda (i) + (when (vectorp i) + (when (slot-value (elt i 0) 'connected) + (xcb:disconnect (elt i 0))))) + exwm-xim--server-client-plist) + ;; Close the IMS connection. + (unless (and exwm-xim--conn + (slot-value exwm-xim--conn 'connected)) + (cl-return-from exwm-xim--exit)) + ;; Remove exwm-xim from XIM_SERVERS. + (let ((reply (xcb:+request-unchecked+reply exwm-xim--conn + (make-instance 'xcb:GetProperty + :delete 1 + :window exwm--root + :property exwm-xim--XIM_SERVERS + :type xcb:Atom:ATOM + :long-offset 0 + :long-length 1000))) + unpacked-reply pack unpack) + (unless reply + (cl-return-from exwm-xim--exit)) + (setq reply (slot-value reply 'value)) + (unless (> (length reply) 4) + (cl-return-from exwm-xim--exit)) + (setq reply (vconcat reply) + pack (if xcb:lsb #'xcb:-pack-u4-lsb #'xcb:-pack-u4) + unpack (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4)) + (dotimes (i (/ (length reply) 4)) + (push (funcall unpack reply (* i 4)) unpacked-reply)) + (setq unpacked-reply (delq exwm-xim--@server unpacked-reply) + reply (mapcar pack unpacked-reply)) + (xcb:+request exwm-xim--conn + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Replace + :window exwm--root + :property exwm-xim--XIM_SERVERS + :type xcb:Atom:ATOM + :format 32 + :data-len (length reply) + :data reply)) + (xcb:flush exwm-xim--conn)) + (xcb:disconnect exwm-xim--conn) + (setq exwm-xim--conn nil)) + +(defun exwm-xim-enable () + "Enable XIM support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-xim--init) + (add-hook 'exwm-exit-hook #'exwm-xim--exit)) + + + +(provide 'exwm-xim) + +;;; exwm-xim.el ends here diff --git a/third_party/exwm/exwm-xsettings.el b/third_party/exwm/exwm-xsettings.el new file mode 100644 index 000000000000..99d6b9c4ac87 --- /dev/null +++ b/third_party/exwm/exwm-xsettings.el @@ -0,0 +1,336 @@ +;;; exwm-xsettings.el --- XSETTINGS Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2024 Free Software Foundation, Inc. + +;; Author: Steven Allen <steven@stebalien.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Implements the XSETTINGS protocol, allowing Emacs to manage the system theme, +;; fonts, icons, etc. +;; +;; This package can be configured as follows: +;; +;; (require 'exwm-xsettings) +;; (setq exwm-xsettings-theme '("Adwaita" . "Adwaita-dark") ;; light/dark +;; exwm-xsettings `(("Xft/HintStyle" . "hintslight") +;; ("Xft/RGBA" . "rgb") +;; ("Xft/lcdfilter" . "lcddefault") +;; ("Xft/Antialias" . 1) +;; ;; DPI is in 1024ths of an inch, so this is a DPI of +;; ;; 144, equivalent to ;; a scaling factor of 1.5 +;; ;; (144 = 1.5 * 96). +;; ("Xft/DPI" . ,(* 144 1024)) +;; ("Xft/Hinting" . 1))) +;; (exwm-xsettings-enable) +;; +;; To modify these settings at runtime, customize them with +;; `custom-set-variables' or `setopt' (Emacs 29+). E.g., the following will +;; immediately change the icon theme to "Papirus" at runtime, even in running +;; applications: +;; +;; (setopt exwm-xsettings-icon-theme "Papirus") + +;;; Code: + +(require 'xcb-ewmh) +(require 'xcb-xsettings) +(require 'exwm-core) + +(defvar exwm-xsettings--connection nil) +(defvar exwm-xsettings--XSETTINGS_SETTINGS-atom nil) +(defvar exwm-xsettings--XSETTINGS_S0-atom nil) +(defvar exwm-xsettings--selection-owner-window nil) +(defvar exwm-xsettings--serial 0) + +(defun exwm-xsettings--rgba-match (_widget value) + "Return t if VALUE is a valid RGBA color." + (and (numberp value) (<= 0 value 1))) + +(defun exwm-xsettings--custom-set (symbol value) + "Setter used by `exwm-xsettings' customization options. + +SYMBOL is the setting being updated and VALUE is the new value." + (set-default-toplevel-value symbol value) + (exwm-xsettings--update-settings)) + +(defgroup exwm-xsettings nil + "XSETTINGS." + :group 'exwm) + +(defcustom exwm-xsettings nil + "Alist of custom XSETTINGS. +These settings take precedence over `exwm-xsettings-theme' and +`exwm-xsettings-icon-theme'." + :type '(alist :key-type (string :tag "Name") + :value-type (choice :tag "Value" + (string :tag "String") + (integer :tag "Integer") + (list :tag "Color" + (number :tag "Red" + :type-error + "This field should contain a number between 0 and 1." + :match exwm-xsettings--rgba-match) + (number :tag "Green" + :type-error + "This field should contain a number between 0 and 1." + :match exwm-xsettings--rgba-match) + (number :tag "Blue" + :type-error + "This field should contain a number between 0 and 1." + :match exwm-xsettings--rgba-match) + (number :tag "Alpha" + :type-error + "This field should contain a number between 0 and 1." + :match exwm-xsettings--rgba-match + :value 1.0)))) + :initialize #'custom-initialize-default + :set #'exwm-xsettings--custom-set) + +(defcustom exwm-xsettings-theme nil + "The system-wide theme." + :type '(choice (string :tag "Theme") + (cons (string :tag "Light Theme") + (string :tag "Dark Theme"))) + :initialize #'custom-initialize-default + :set #'exwm-xsettings--custom-set) + +(defcustom exwm-xsettings-icon-theme nil + "The system-wide icon theme." + :type '(choice (string :tag "Icon Theme") + (cons (string :tag "Light Icon Theme") + (string :tag "Dark Icon Theme"))) + :initialize #'custom-initialize-default + :set #'exwm-xsettings--custom-set) + +(defalias 'exwm-xsettings--color-dark-p + (if (eval-when-compile (< emacs-major-version 29)) + ;; Borrowed from Emacs 29. + (lambda (rgb) + "Whether RGB is more readable against white than black." + (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1) + (error "RGB components %S not in [0,1]" rgb)) + (let* ((r (expt (nth 0 rgb) 2.2)) + (g (expt (nth 1 rgb) 2.2)) + (b (expt (nth 2 rgb) 2.2)) + (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722)))) + (< y 0.325))) + 'color-dark-p)) + +(defun exwm-xsettings--pick-theme (theme) + "Pick a light or dark theme from the given THEME. +If THEME is a string, it's returned directly. +If THEME is a cons of (LIGHT . DARK), the appropriate theme is picked based on +the default face's background color." + (pcase theme + ((cl-type string) theme) + (`(,(cl-type string) . ,(cl-type string)) + (if (exwm-xsettings--color-dark-p (color-name-to-rgb (face-background 'default))) + (cdr theme) (car theme))) + (_ (error "Expected theme to be a string or a pair of strings")))) + +(defun exwm-xsettings--get-settings () + "Get the current settings. +Combines `exwm-xsettings', `exwm-xsettings-theme' (if set), and +`exwm-xsettings-icon-theme' (if set)." + (cl-remove-duplicates + (append + exwm-xsettings + (when exwm-xsettings-theme + (list (cons "Net/ThemeName" (exwm-xsettings--pick-theme exwm-xsettings-theme)))) + (when exwm-xsettings-icon-theme + (list (cons "Net/IconThemeName" (exwm-xsettings--pick-theme exwm-xsettings-icon-theme))))) + :key 'car + :test 'string=)) + +(defun exwm-xsettings--make-settings (settings serial) + "Construct a new settings object. +SETTINGS is an alist of key/value pairs. +SERIAL is a sequence number." + (make-instance 'xcb:xsettings:-Settings + :byte-order (if xcb:lsb 0 1) + :serial serial + :settings-len (length settings) + :settings + (mapcar + (lambda (prop) + (let* ((name (car prop)) + (value (cdr prop)) + (common (list :name name + :name-len (length name) + :last-change-serial serial))) + (pcase value + ((cl-type string) + (apply #'make-instance 'xcb:xsettings:-SETTING_STRING + :value-len (length value) + :value value + common)) + ((cl-type integer) + (apply #'make-instance 'xcb:xsettings:-SETTING_INTEGER + :value value common)) + ((and (cl-type list) (app length (or 3 4))) + ;; Convert from RGB(A) to 16bit integers. + (setq value (mapcar (lambda (x) (round (* x #xffff))) value)) + (apply #'make-instance 'xcb:xsettings:-SETTING_COLOR + :red (pop value) + :green (pop value) + :blue (pop value) + :alpha (or (pop value) #xffff))) + (_ (error "Setting value must be a string, integer, or length 3-4 list"))))) + settings))) + +(defun exwm-xsettings--update-settings () + "Update the xsettings." + (when exwm-xsettings--connection + (setq exwm-xsettings--serial (1+ exwm-xsettings--serial)) + (let* ((settings (exwm-xsettings--get-settings)) + (bytes (xcb:marshal (exwm-xsettings--make-settings settings exwm-xsettings--serial)))) + (xcb:+request exwm-xsettings--connection + (make-instance 'xcb:ChangeProperty + :mode xcb:PropMode:Replace + :window exwm-xsettings--selection-owner-window + :property exwm-xsettings--XSETTINGS_SETTINGS-atom + :type exwm-xsettings--XSETTINGS_SETTINGS-atom + :format 8 + :data-len (length bytes) + :data bytes))) + (xcb:flush exwm-xsettings--connection))) + +(defun exwm-xsettings--on-theme-change (&rest _) + "Called when the Emacs theme is changed." + ;; We only bother updating the xsettings if changing the theme could effect + ;; the settings. + (when (or (consp exwm-xsettings-theme) (consp exwm-xsettings-icon-theme)) + (exwm-xsettings--update-settings))) + +(defun exwm-xsettings--on-SelectionClear (_data _synthetic) + "Called when another xsettings daemon takes over." + (exwm--log "XSETTINGS manager has been replaced.") + (exwm-xsettings--exit)) + +(cl-defun exwm-xsettings--init () + "Initialize the XSETTINGS module." + (exwm--log) + + (cl-assert (not exwm-xsettings--connection)) + + ;; Connect + (setq exwm-xsettings--connection (xcb:connect)) + (set-process-query-on-exit-flag (slot-value exwm-xsettings--connection + 'process) + nil) + + ;; Intern the atoms. + (setq exwm-xsettings--XSETTINGS_SETTINGS-atom + (exwm--intern-atom "_XSETTINGS_SETTINGS" exwm-xsettings--connection) + + exwm-xsettings--XSETTINGS_S0-atom + (exwm--intern-atom "_XSETTINGS_S0" exwm-xsettings--connection)) + + ;; Detect running XSETTINGS managers. + (with-slots (owner) + (xcb:+request-unchecked+reply exwm-xsettings--connection + (make-instance 'xcb:GetSelectionOwner + :selection exwm-xsettings--XSETTINGS_S0-atom)) + (when (/= owner xcb:Window:None) + (xcb:disconnect exwm-xsettings--connection) + (setq exwm-xsettings--connection nil) + (warn "[EXWM] Other XSETTINGS manager detected") + (cl-return-from exwm-xsettings--init))) + + (let ((id(xcb:generate-id exwm-xsettings--connection))) + (setq exwm-xsettings--selection-owner-window id) + + ;; Create a settings window. + (xcb:+request exwm-xsettings--connection + (make-instance 'xcb:CreateWindow + :wid id + :parent exwm--root + :class xcb:WindowClass:InputOnly + :x 0 + :y 0 + :width 1 + :height 1 + :border-width 0 + :depth 0 + :visual 0 + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + + ;; Set _NET_WM_NAME. + (xcb:+request exwm-xsettings--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window id + :data "EXWM: exwm-xsettings--selection-owner-window")) + + ;; Apply the XSETTINGS properties. + (exwm-xsettings--update-settings) + + ;; Take ownership and notify. + (xcb:+request exwm-xsettings--connection + (make-instance 'xcb:SetSelectionOwner + :owner id + :selection exwm-xsettings--XSETTINGS_S0-atom + :time xcb:Time:CurrentTime)) + (xcb:+request exwm-xsettings--connection + (make-instance 'xcb:SendEvent + :propagate 0 + :destination exwm--root + :event-mask xcb:EventMask:StructureNotify + :event (xcb:marshal + (make-instance 'xcb:xsettings:-ClientMessage + :window exwm--root + :time xcb:Time:CurrentTime + :selection exwm-xsettings--XSETTINGS_S0-atom + :owner id) + exwm-xsettings--connection))) + + ;; Detect loss of XSETTINGS ownership. + (xcb:+event exwm-xsettings--connection 'xcb:SelectionClear + #'exwm-xsettings--on-SelectionClear) + + (xcb:flush exwm-xsettings--connection)) + + ;; Update the xsettings if/when the theme changes. + (add-hook 'enable-theme-functions #'exwm-xsettings--on-theme-change) + (add-hook 'disable-theme-functions #'exwm-xsettings--on-theme-change)) + +(defun exwm-xsettings--exit () + "Exit the XSETTINGS module." + (exwm--log) + + (when exwm-xsettings--connection + (remove-hook 'enable-theme-functions #'exwm-xsettings--on-theme-change) + (remove-hook 'disable-theme-functions #'exwm-xsettings--on-theme-change) + + (xcb:disconnect exwm-xsettings--connection) + + (setq exwm-xsettings--connection nil + exwm-xsettings--XSETTINGS_SETTINGS-atom nil + exwm-xsettings--XSETTINGS_S0-atom nil + exwm-xsettings--selection-owner-window nil))) + +(defun exwm-xsettings-enable () + "Enable xsettings support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-xsettings--init) + (add-hook 'exwm-exit-hook #'exwm-xsettings--exit)) + +(provide 'exwm-xsettings) + +;;; exwm-xsettings.el ends here diff --git a/third_party/exwm/exwm.el b/third_party/exwm/exwm.el new file mode 100644 index 000000000000..c4900eab48ca --- /dev/null +++ b/third_party/exwm/exwm.el @@ -0,0 +1,1113 @@ +;;; exwm.el --- Emacs X Window Manager -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. + +;; Author: Chris Feng <chris.w.feng@gmail.com> +;; Maintainer: Adriรกn Medraรฑo Calvo <adrian@medranocalvo.com>, Steven Allen <steven@stebalien.com>, Daniel Mendler <mail@daniel-mendler.de> +;; Version: 0.28 +;; Package-Requires: ((emacs "27.1") (xelb "0.18")) +;; Keywords: unix +;; URL: https://github.com/emacs-exwm/exwm + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Overview +;; -------- +;; EXWM (Emacs X Window Manager) is a full-featured tiling X window manager +;; for Emacs built on top of [XELB](https://github.com/emacs-exwm/xelb). +;; It features: +;; + Fully keyboard-driven operations +;; + Hybrid layout modes (tiling & stacking) +;; + Dynamic workspace support +;; + ICCCM/EWMH compliance +;; Optional features: +;; + RandR (multi-monitor) support +;; + System tray +;; + Input method +;; + Background setting support +;; + XSETTINGS server + +;; Installation & configuration +;; ---------------------------- +;; Here are the minimal steps to get EXWM working: +;; 1. Install XELB and EXWM, and make sure they are in `load-path'. +;; 2. In '~/.emacs', add following lines (please modify accordingly): +;; +;; (require 'exwm) +;; (require 'exwm-config) +;; (exwm-config-example) +;; +;; 3. Link or copy the file 'xinitrc' to '~/.xinitrc'. +;; 4. Launch EXWM in a console (e.g. tty1) with +;; +;; xinit -- vt01 +;; +;; You should additionally hide the menu-bar, tool-bar, etc to increase the +;; usable space. Please check the wiki (https://github.com/emacs-exwm/exwm/wiki) +;; for more detailed instructions on installation, configuration, usage, etc. + +;; References: +;; + dwm (http://dwm.suckless.org/) +;; + i3 wm (https://i3wm.org/) +;; + Also see references within each required library. + +;;; Code: + +(require 'server) +(require 'exwm-core) +(require 'exwm-workspace) +(require 'exwm-layout) +(require 'exwm-floating) +(require 'exwm-manage) +(require 'exwm-input) + +(declare-function x-get-atom-name "C source code" (VALUE &optional FRAME)) + +(defgroup exwm nil + "Emacs X Window Manager." + :tag "EXWM" + :group 'applications + :prefix "exwm-") + +(defcustom exwm-init-hook nil + "Normal hook run when EXWM has just finished initialization." + :type 'hook) + +(defcustom exwm-exit-hook nil + "Normal hook run just before EXWM exits." + :type 'hook) + +(defcustom exwm-update-class-hook nil + "Normal hook run when window class is updated." + :type 'hook) + +(defcustom exwm-update-title-hook nil + "Normal hook run when window title is updated." + :type 'hook) + +(defcustom exwm-blocking-subrs + ;; `x-file-dialog' and `x-select-font' are missing on some Emacs builds, for + ;; example on the X11 Lucid build. + '(x-file-dialog x-popup-dialog x-select-font message-box message-or-box) + "Subrs (primitives) that would normally block EXWM." + :type '(repeat function)) + +(defcustom exwm-replace 'ask + "Whether to replace existing window manager." + :type '(radio (const :tag "Ask" ask) + (const :tag "Replace by default" t) + (const :tag "Do not replace" nil))) + +(defconst exwm--server-name "server-exwm" + "Name of the subordinate Emacs server.") + +(defvar exwm--server-timeout 1 + "Number of seconds to wait for the subordinate Emacs server to exit. +After this time, the server will be killed.") + +(defvar exwm--server-process nil "Process of the subordinate Emacs server.") + +(defun exwm-reset () + "Reset the state of the selected window (non-fullscreen, line-mode, etc)." + (interactive) + (exwm--log) + (with-current-buffer (window-buffer) + (when (derived-mode-p 'exwm-mode) + (when (exwm-layout--fullscreen-p) + (exwm-layout-unset-fullscreen)) + ;; Force refresh + (exwm-layout--refresh) + (call-interactively #'exwm-input-grab-keyboard)))) + +;;;###autoload +(defun exwm-restart () + "Restart EXWM." + (interactive) + (exwm--log) + (when (exwm--confirm-kill-emacs "Restart?" 'no-check) + (let* ((attr (process-attributes (emacs-pid))) + (args (cdr (assq 'args attr))) + (ppid (cdr (assq 'ppid attr))) + (pargs (cdr (assq 'args (process-attributes ppid))))) + (cond + ((= ppid 1) + ;; The parent is the init process. This probably means this + ;; instance is an emacsclient. Anyway, start a control instance + ;; to manage the subsequent ones. + (call-process (car command-line-args)) + (kill-emacs)) + ((string= args pargs) + ;; This is a subordinate instance. Return a magic number to + ;; inform the parent (control instance) to start another one. + (kill-emacs ?R)) + (t + ;; This is the control instance. Keep starting subordinate + ;; instances until told to exit. + ;; Run `server-force-stop' if it exists. + (run-hooks 'kill-emacs-hook) + (with-temp-buffer + (while (= ?R (shell-command-on-region (point) (point) args)))) + (kill-emacs)))))) + +(defun exwm--update-desktop (xwin) + "Update _NET_WM_DESKTOP. +Argument XWIN contains the X window of the `exwm-mode' buffer." + (exwm--log "#x%x" xwin) + (with-current-buffer (exwm--id->buffer xwin) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_DESKTOP + :window xwin))) + desktop) + (when reply + (setq desktop (slot-value reply 'value)) + (cond + ((and desktop (= desktop 4294967295.)) + (unless (or (not exwm--floating-frame) + (eq exwm--frame exwm-workspace--current) + (and exwm--desktop + (= desktop exwm--desktop))) + (exwm-layout--show xwin (frame-root-window exwm--floating-frame))) + (setq exwm--desktop desktop)) + ((and desktop + (< desktop (exwm-workspace--count)) + (if exwm--desktop + (/= desktop exwm--desktop) + (/= desktop (exwm-workspace--position exwm--frame)))) + (exwm-workspace-move-window desktop xwin)) + (t + (exwm-workspace--set-desktop xwin))))))) + +(defun exwm--update-window-type (id &optional force) + "Update `exwm-window-type' from _NET_WM_WINDOW_TYPE. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if +`exwm-window-type' is unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and exwm-window-type (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_WINDOW_TYPE + :window id)))) + (when reply ;nil when destroyed + (setq exwm-window-type (append (slot-value reply 'value) nil))))))) + +(defun exwm--update-class (id &optional force) + "Update `exwm-instance-name' and `exwm-class' from WM_CLASS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if any of +`exwm-instance-name' or `exwm-class' is unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and exwm-instance-name exwm-class-name (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_CLASS :window id)))) + (when reply ;nil when destroyed + (setq exwm-instance-name (slot-value reply 'instance-name) + exwm-class-name (slot-value reply 'class-name)) + (when (and exwm-instance-name exwm-class-name) + (run-hooks 'exwm-update-class-hook))))))) + +(defun exwm--update-utf8-title (id &optional force) + "Update `exwm-title' from _NET_WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (when (or force (not exwm-title)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_NAME :window id)))) + (when reply ;nil when destroyed + (setq exwm-title (slot-value reply 'value)) + (when exwm-title + (setq exwm--title-is-utf8 t) + (run-hooks 'exwm-update-title-hook))))))) + +(defun exwm--update-ctext-title (id &optional force) + "Update `exwm-title' from WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (or exwm--title-is-utf8 + (and exwm-title (not force))) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_NAME :window id)))) + (when reply ;nil when destroyed + (setq exwm-title (slot-value reply 'value)) + (when exwm-title + (run-hooks 'exwm-update-title-hook))))))) + +(defun exwm--update-title (id) + "Update _NET_WM_NAME or WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer." + (exwm--log "#x%x" id) + (exwm--update-utf8-title id) + (exwm--update-ctext-title id)) + +(defun exwm--update-transient-for (id &optional force) + "Update `exwm-transient-for' from WM_TRANSIENT_FOR. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and exwm-transient-for (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_TRANSIENT_FOR + :window id)))) + (when reply ;nil when destroyed + (setq exwm-transient-for (slot-value reply 'value))))))) + +(defun exwm--update-normal-hints (id &optional force) + "Update normal hints from WM_NORMAL_HINTS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place all of +`exwm--normal-hints-x exwm--normal-hints-y', +`exwm--normal-hints-width exwm--normal-hints-height', +`exwm--normal-hints-min-width exwm--normal-hints-min-height' and +`exwm--normal-hints-max-width exwm--normal-hints-max-height' are +unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and (not force) + (or exwm--normal-hints-x exwm--normal-hints-y + exwm--normal-hints-width exwm--normal-hints-height + exwm--normal-hints-min-width exwm--normal-hints-min-height + exwm--normal-hints-max-width exwm--normal-hints-max-height + ;; FIXME: other fields + )) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_NORMAL_HINTS + :window id)))) + (when (and reply (slot-value reply 'flags)) ;nil when destroyed + (with-slots (flags x y width height min-width min-height max-width + max-height base-width base-height ;; win-gravity + ) + reply + (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USPosition)) + (setq exwm--normal-hints-x x exwm--normal-hints-y y)) + (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USSize)) + (setq exwm--normal-hints-width width + exwm--normal-hints-height height)) + (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMinSize)) + (setq exwm--normal-hints-min-width min-width + exwm--normal-hints-min-height min-height)) + (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMaxSize)) + (setq exwm--normal-hints-max-width max-width + exwm--normal-hints-max-height max-height)) + (unless (or exwm--normal-hints-min-width + (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PBaseSize))) + (setq exwm--normal-hints-min-width base-width + exwm--normal-hints-min-height base-height)) + ;; (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PWinGravity)) + ;; (setq exwm--normal-hints-win-gravity win-gravity)) + (setq exwm--fixed-size + (and exwm--normal-hints-min-width + exwm--normal-hints-min-height + exwm--normal-hints-max-width + exwm--normal-hints-max-height + (/= 0 exwm--normal-hints-min-width) + (/= 0 exwm--normal-hints-min-height) + (= exwm--normal-hints-min-width + exwm--normal-hints-max-width) + (= exwm--normal-hints-min-height + exwm--normal-hints-max-height))))))))) + +(defun exwm--update-hints (id &optional force) + "Update hints from WM_HINTS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if both of +`exwm--hints-input' and `exwm--hints-urgency' are unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and (not force) exwm--hints-input exwm--hints-urgency) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_HINTS :window id)))) + (when (and reply (slot-value reply 'flags)) ;nil when destroyed + (with-slots (flags input initial-state) reply + (when flags + (unless (= 0 (logand flags xcb:icccm:WM_HINTS:InputHint)) + (setq exwm--hints-input (when input (= 1 input)))) + (unless (= 0 (logand flags xcb:icccm:WM_HINTS:StateHint)) + (setq exwm-state initial-state)) + (unless (= 0 (logand flags xcb:icccm:WM_HINTS:UrgencyHint)) + (setq exwm--hints-urgency t)))) + (when (and exwm--hints-urgency + (not (eq exwm--frame exwm-workspace--current))) + (unless (frame-parameter exwm--frame 'exwm-urgency) + (set-frame-parameter exwm--frame 'exwm-urgency t) + (setq exwm-workspace--switch-history-outdated t)))))))) + +(defun exwm--update-protocols (id &optional force) + "Update `exwm--protocols' from WM_PROTOCOLS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm--protocols' +is unset." + (exwm--log "#x%x" id) + (with-current-buffer (exwm--id->buffer id) + (unless (and exwm--protocols (not force)) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:icccm:get-WM_PROTOCOLS + :window id)))) + (when reply ;nil when destroyed + (setq exwm--protocols (append (slot-value reply 'value) nil))))))) + +(defun exwm--update-struts-legacy (id) + "Update struts of X window ID from _NET_WM_STRUT." + (exwm--log "#x%x" id) + (let ((pair (assq id exwm-workspace--id-struts-alist)) + reply struts) + (unless (and pair (< 4 (length (cdr pair)))) + (setq reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_STRUT + :window id))) + (when reply + (setq struts (slot-value reply 'value)) + (if pair + (setcdr pair struts) + (push (cons id struts) exwm-workspace--id-struts-alist)) + (exwm-workspace--update-struts)) + ;; Update workareas. + (exwm-workspace--update-workareas) + ;; Update workspaces. + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f))))) + +(defun exwm--update-struts-partial (id) + "Update struts of X window ID from _NET_WM_STRUT_PARTIAL." + (exwm--log "#x%x" id) + (let ((reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_STRUT_PARTIAL + :window id))) + struts pair) + (when reply + (setq struts (slot-value reply 'value) + pair (assq id exwm-workspace--id-struts-alist)) + (if pair + (setcdr pair struts) + (push (cons id struts) exwm-workspace--id-struts-alist)) + (exwm-workspace--update-struts)) + ;; Update workareas. + (exwm-workspace--update-workareas) + ;; Update workspaces. + (dolist (f exwm-workspace--list) + (exwm-workspace--set-fullscreen f)))) + +(defun exwm--update-struts (id) + "Update struts of X window ID from _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT." + (exwm--log "#x%x" id) + (exwm--update-struts-partial id) + (exwm--update-struts-legacy id)) + +(defun exwm--on-PropertyNotify (data _synthetic) + "Handle PropertyNotify event. +DATA contains unmarshalled PropertyNotify event data." + (let ((obj (make-instance 'xcb:PropertyNotify)) + atom id buffer) + (xcb:unmarshal obj data) + (setq id (slot-value obj 'window) + atom (slot-value obj 'atom)) + (exwm--log "atom=%s(%s)" (x-get-atom-name atom exwm-workspace--current) atom) + (setq buffer (exwm--id->buffer id)) + (if (not (buffer-live-p buffer)) + ;; Properties of unmanaged X windows. + (cond ((= atom xcb:Atom:_NET_WM_STRUT) + (exwm--update-struts-legacy id)) + ((= atom xcb:Atom:_NET_WM_STRUT_PARTIAL) + (exwm--update-struts-partial id))) + (with-current-buffer buffer + (cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE) + (exwm--update-window-type id t)) + ((= atom xcb:Atom:WM_CLASS) + (exwm--update-class id t)) + ((= atom xcb:Atom:_NET_WM_NAME) + (exwm--update-utf8-title id t)) + ((= atom xcb:Atom:WM_NAME) + (exwm--update-ctext-title id t)) + ((= atom xcb:Atom:WM_TRANSIENT_FOR) + (exwm--update-transient-for id t)) + ((= atom xcb:Atom:WM_NORMAL_HINTS) + (exwm--update-normal-hints id t)) + ((= atom xcb:Atom:WM_HINTS) + (exwm--update-hints id t)) + ((= atom xcb:Atom:WM_PROTOCOLS) + (exwm--update-protocols id t)) + ((= atom xcb:Atom:_NET_WM_USER_TIME)) ;ignored + (t + (exwm--log "Unhandled: %s(%d)" + (x-get-atom-name atom exwm-workspace--current) + atom))))))) + +(defun exwm--on-ClientMessage (raw-data _synthetic) + "Handle ClientMessage event. +RAW-DATA contains unmarshalled ClientMessage event data." + (let ((obj (make-instance 'xcb:ClientMessage)) + type id data) + (xcb:unmarshal obj raw-data) + (setq type (slot-value obj 'type) + id (slot-value obj 'window) + data (slot-value (slot-value obj 'data) 'data32)) + (exwm--log "atom=%s(%s) id=#x%x data=%s" (x-get-atom-name type exwm-workspace--current) + type (or id 0) data) + (cond + ;; _NET_NUMBER_OF_DESKTOPS. + ((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS) + (let ((current (exwm-workspace--count)) + (requested (elt data 0))) + ;; Only allow increasing/decreasing the workspace number by 1. + (cond + ((< current requested) + (make-frame)) + ((and (> current requested) + (> current 1)) + (let ((frame (car (last exwm-workspace--list)))) + (delete-frame frame)))))) + ;; _NET_CURRENT_DESKTOP. + ((= type xcb:Atom:_NET_CURRENT_DESKTOP) + (exwm-workspace-switch (elt data 0))) + ;; _NET_ACTIVE_WINDOW. + ((= type xcb:Atom:_NET_ACTIVE_WINDOW) + (let ((buffer (exwm--id->buffer id)) + iconic window) + (if (buffer-live-p buffer) + ;; Either an `exwm-mode' buffer (an X window) or a floating frame. + (with-current-buffer buffer + (when (eq exwm--frame exwm-workspace--current) + (if exwm--floating-frame + (select-frame exwm--floating-frame) + (setq iconic (exwm-layout--iconic-state-p)) + (when iconic + ;; State change: iconic => normal. + (set-window-buffer (frame-selected-window exwm--frame) + (current-buffer))) + ;; Focus transfer. + (setq window (get-buffer-window nil t)) + (when (or iconic + (not (eq window (selected-window)))) + (select-window window))))) + ;; A workspace. + (dolist (f exwm-workspace--list) + (when (eq id (frame-parameter f 'exwm-outer-id)) + (x-focus-frame f t)))))) + ;; _NET_CLOSE_WINDOW. + ((= type xcb:Atom:_NET_CLOSE_WINDOW) + (let ((buffer (exwm--id->buffer id))) + (when (buffer-live-p buffer) + (exwm--defer 0 #'kill-buffer buffer)))) + ;; _NET_WM_MOVERESIZE + ((= type xcb:Atom:_NET_WM_MOVERESIZE) + (let ((direction (elt data 2)) + (buffer (exwm--id->buffer id))) + (unless (and buffer + (not (buffer-local-value 'exwm--floating-frame buffer))) + (cond ((= direction + xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_KEYBOARD) + ;; FIXME + ) + ((= direction + xcb:ewmh:_NET_WM_MOVERESIZE_MOVE_KEYBOARD) + ;; FIXME + ) + ((= direction xcb:ewmh:_NET_WM_MOVERESIZE_CANCEL) + (exwm-floating--stop-moveresize)) + ;; In case it's a workspace frame. + ((and (not buffer) + (catch 'break + (dolist (f exwm-workspace--list) + (when (or (eq id (frame-parameter f 'exwm-outer-id)) + (eq id (frame-parameter f 'exwm-id))) + (throw 'break t))) + nil))) + (t + ;; In case it's a floating frame, + ;; move the corresponding X window instead. + (unless buffer + (catch 'break + (dolist (pair exwm--id-buffer-alist) + (with-current-buffer (cdr pair) + (when + (and exwm--floating-frame + (or (eq id + (frame-parameter exwm--floating-frame + 'exwm-outer-id)) + (eq id + (frame-parameter exwm--floating-frame + 'exwm-id)))) + (setq id exwm--id) + (throw 'break nil)))))) + ;; Start to move it. + (exwm-floating--start-moveresize id direction)))))) + ;; _NET_REQUEST_FRAME_EXTENTS + ((= type xcb:Atom:_NET_REQUEST_FRAME_EXTENTS) + (let ((buffer (exwm--id->buffer id)) + top btm) + (if (or (not buffer) + (not (buffer-local-value 'exwm--floating-frame buffer))) + (setq top 0 + btm 0) + (setq top (window-header-line-height) + btm (window-mode-line-height))) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_FRAME_EXTENTS + :window id + :left 0 + :right 0 + :top top + :bottom btm))) + (xcb:flush exwm--connection)) + ;; _NET_WM_DESKTOP. + ((= type xcb:Atom:_NET_WM_DESKTOP) + (let ((buffer (exwm--id->buffer id))) + (when (buffer-live-p buffer) + (exwm-workspace-move-window (elt data 0) id)))) + ;; _NET_WM_STATE + ((= type xcb:Atom:_NET_WM_STATE) + (let ((action (elt data 0)) + (props (list (elt data 1) (elt data 2))) + (buffer (exwm--id->buffer id)) + props-new) + ;; only support _NET_WM_STATE_FULLSCREEN / _NET_WM_STATE_ADD for frames + (when (and (not buffer) + (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props) + (= action xcb:ewmh:_NET_WM_STATE_ADD)) + (xcb:+request + exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_STATE + :window id + :data (vector xcb:Atom:_NET_WM_STATE_FULLSCREEN))) + (xcb:flush exwm--connection)) + (when buffer ;ensure it's managed + (with-current-buffer buffer + ;; _NET_WM_STATE_FULLSCREEN + (when (or (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props) + (memq xcb:Atom:_NET_WM_STATE_ABOVE props)) + (cond ((= action xcb:ewmh:_NET_WM_STATE_ADD) + (unless (exwm-layout--fullscreen-p) + (exwm-layout-set-fullscreen id)) + (push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new)) + ((= action xcb:ewmh:_NET_WM_STATE_REMOVE) + (when (exwm-layout--fullscreen-p) + (exwm-layout-unset-fullscreen id))) + ((= action xcb:ewmh:_NET_WM_STATE_TOGGLE) + (if (exwm-layout--fullscreen-p) + (exwm-layout-unset-fullscreen id) + (exwm-layout-set-fullscreen id) + (push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new))))) + ;; _NET_WM_STATE_DEMANDS_ATTENTION + ;; FIXME: check (may require other properties set) + (when (memq xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION props) + (when (= action xcb:ewmh:_NET_WM_STATE_ADD) + (unless (eq exwm--frame exwm-workspace--current) + (set-frame-parameter exwm--frame 'exwm-urgency t) + (setq exwm-workspace--switch-history-outdated t))) + ;; xcb:ewmh:_NET_WM_STATE_REMOVE? + ;; xcb:ewmh:_NET_WM_STATE_TOGGLE? + ) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_STATE + :window id :data (vconcat props-new))) + (xcb:flush exwm--connection))))) + ((= type xcb:Atom:WM_PROTOCOLS) + (let ((type (elt data 0))) + (cond ((= type xcb:Atom:_NET_WM_PING) + (setq exwm-manage--ping-lock nil)) + (t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type))))) + ((= type xcb:Atom:WM_CHANGE_STATE) + (let ((buffer (exwm--id->buffer id))) + (when (and (buffer-live-p buffer) + (= (elt data 0) xcb:icccm:WM_STATE:IconicState)) + (with-current-buffer buffer + (if exwm--floating-frame + (call-interactively #'exwm-floating-hide) + (bury-buffer)))))) + (t + (exwm--log "Unhandled: %s(%d)" + (x-get-atom-name type exwm-workspace--current) type))))) + +(defun exwm--on-SelectionClear (data _synthetic) + "Handle SelectionClear events. +DATA contains unmarshalled SelectionClear event data." + (exwm--log) + (let ((obj (make-instance 'xcb:SelectionClear)) + owner selection) + (xcb:unmarshal obj data) + (setq owner (slot-value obj 'owner) + selection (slot-value obj 'selection)) + (when (and (eq owner exwm--wmsn-window) + (eq selection xcb:Atom:WM_S0)) + (exwm-exit)))) + +(defun exwm--on-delete-terminal (terminal) + "Handle terminal being deleted without Emacs being killed. +This function is Hooked to `delete-terminal-functions'. + +TERMINAL is the terminal being (or that has been) deleted. + +This may happen when invoking `save-buffers-kill-terminal' within an emacsclient +session." + (when (eq terminal exwm--terminal) + (exwm-exit))) + +(defun exwm--init-icccm-ewmh () + "Initialize ICCCM/EWMH support." + (exwm--log) + ;; Handle PropertyNotify event + (xcb:+event exwm--connection 'xcb:PropertyNotify #'exwm--on-PropertyNotify) + ;; Handle relevant client messages + (xcb:+event exwm--connection 'xcb:ClientMessage #'exwm--on-ClientMessage) + ;; Handle SelectionClear + (xcb:+event exwm--connection 'xcb:SelectionClear #'exwm--on-SelectionClear) + ;; Set _NET_SUPPORTED + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_SUPPORTED + :window exwm--root + :data (vector + ;; Root windows properties. + xcb:Atom:_NET_SUPPORTED + xcb:Atom:_NET_CLIENT_LIST + xcb:Atom:_NET_CLIENT_LIST_STACKING + xcb:Atom:_NET_NUMBER_OF_DESKTOPS + xcb:Atom:_NET_DESKTOP_GEOMETRY + xcb:Atom:_NET_DESKTOP_VIEWPORT + xcb:Atom:_NET_CURRENT_DESKTOP + ;; xcb:Atom:_NET_DESKTOP_NAMES + xcb:Atom:_NET_ACTIVE_WINDOW + ;; xcb:Atom:_NET_WORKAREA + xcb:Atom:_NET_SUPPORTING_WM_CHECK + ;; xcb:Atom:_NET_VIRTUAL_ROOTS + ;; xcb:Atom:_NET_DESKTOP_LAYOUT + ;; xcb:Atom:_NET_SHOWING_DESKTOP + + ;; Other root window messages. + xcb:Atom:_NET_CLOSE_WINDOW + ;; xcb:Atom:_NET_MOVERESIZE_WINDOW + xcb:Atom:_NET_WM_MOVERESIZE + ;; xcb:Atom:_NET_RESTACK_WINDOW + xcb:Atom:_NET_REQUEST_FRAME_EXTENTS + + ;; Application window properties. + xcb:Atom:_NET_WM_NAME + ;; xcb:Atom:_NET_WM_VISIBLE_NAME + ;; xcb:Atom:_NET_WM_ICON_NAME + ;; xcb:Atom:_NET_WM_VISIBLE_ICON_NAME + xcb:Atom:_NET_WM_DESKTOP + ;; + xcb:Atom:_NET_WM_WINDOW_TYPE + ;; xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP + xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK + xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR + xcb:Atom:_NET_WM_WINDOW_TYPE_MENU + xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY + xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH + xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG + xcb:Atom:_NET_WM_WINDOW_TYPE_DROPDOWN_MENU + xcb:Atom:_NET_WM_WINDOW_TYPE_POPUP_MENU + xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLTIP + xcb:Atom:_NET_WM_WINDOW_TYPE_NOTIFICATION + xcb:Atom:_NET_WM_WINDOW_TYPE_COMBO + xcb:Atom:_NET_WM_WINDOW_TYPE_DND + xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL + ;; + xcb:Atom:_NET_WM_STATE + ;; xcb:Atom:_NET_WM_STATE_MODAL + ;; xcb:Atom:_NET_WM_STATE_STICKY + ;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_VERT + ;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_HORZ + ;; xcb:Atom:_NET_WM_STATE_SHADED + ;; xcb:Atom:_NET_WM_STATE_SKIP_TASKBAR + ;; xcb:Atom:_NET_WM_STATE_SKIP_PAGER + xcb:Atom:_NET_WM_STATE_HIDDEN + xcb:Atom:_NET_WM_STATE_FULLSCREEN + ;; xcb:Atom:_NET_WM_STATE_ABOVE + ;; xcb:Atom:_NET_WM_STATE_BELOW + xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION + ;; xcb:Atom:_NET_WM_STATE_FOCUSED + ;; + xcb:Atom:_NET_WM_ALLOWED_ACTIONS + xcb:Atom:_NET_WM_ACTION_MOVE + xcb:Atom:_NET_WM_ACTION_RESIZE + xcb:Atom:_NET_WM_ACTION_MINIMIZE + ;; xcb:Atom:_NET_WM_ACTION_SHADE + ;; xcb:Atom:_NET_WM_ACTION_STICK + ;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_HORZ + ;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_VERT + xcb:Atom:_NET_WM_ACTION_FULLSCREEN + xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP + xcb:Atom:_NET_WM_ACTION_CLOSE + ;; xcb:Atom:_NET_WM_ACTION_ABOVE + ;; xcb:Atom:_NET_WM_ACTION_BELOW + ;; + xcb:Atom:_NET_WM_STRUT + xcb:Atom:_NET_WM_STRUT_PARTIAL + ;; xcb:Atom:_NET_WM_ICON_GEOMETRY + ;; xcb:Atom:_NET_WM_ICON + xcb:Atom:_NET_WM_PID + ;; xcb:Atom:_NET_WM_HANDLED_ICONS + ;; xcb:Atom:_NET_WM_USER_TIME + ;; xcb:Atom:_NET_WM_USER_TIME_WINDOW + xcb:Atom:_NET_FRAME_EXTENTS + ;; xcb:Atom:_NET_WM_OPAQUE_REGION + ;; xcb:Atom:_NET_WM_BYPASS_COMPOSITOR + + ;; Window manager protocols. + xcb:Atom:_NET_WM_PING + ;; xcb:Atom:_NET_WM_SYNC_REQUEST + ;; xcb:Atom:_NET_WM_FULLSCREEN_MONITORS + + ;; Other properties. + xcb:Atom:_NET_WM_FULL_PLACEMENT))) + ;; Create a child window for setting _NET_SUPPORTING_WM_CHECK + (let ((new-id (xcb:generate-id exwm--connection))) + (setq exwm--guide-window new-id) + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid new-id + :parent exwm--root + :x -1 + :y -1 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:InputOnly + :visual 0 + :value-mask xcb:CW:OverrideRedirect + :override-redirect 1)) + ;; Set _NET_WM_NAME. Must be set to the name of the window manager, as + ;; required by wm-spec. + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window new-id :data "EXWM")) + (dolist (i (list exwm--root new-id)) + ;; Set _NET_SUPPORTING_WM_CHECK + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_SUPPORTING_WM_CHECK + :window i :data new-id)))) + ;; Set _NET_DESKTOP_VIEWPORT (we don't support large desktop). + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT + :window exwm--root + :data [0 0])) + (xcb:flush exwm--connection)) + +(defun exwm--wmsn-acquire (replace) + "Acquire the WM_Sn selection. + +REPLACE specifies what to do in case there already is a window +manager. If t, replace it, if nil, abort and ask the user if `ask'." + (exwm--log "%s" replace) + (with-slots (owner) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetSelectionOwner + :selection xcb:Atom:WM_S0)) + (when (/= owner xcb:Window:None) + (when (eq replace 'ask) + (setq replace (yes-or-no-p "Replace existing window manager? "))) + (when (not replace) + (user-error "Other window manager detected"))) + (let ((new-owner (xcb:generate-id exwm--connection))) + (xcb:+request exwm--connection + (make-instance 'xcb:CreateWindow + :depth 0 + :wid new-owner + :parent exwm--root + :x -1 + :y -1 + :width 1 + :height 1 + :border-width 0 + :class xcb:WindowClass:CopyFromParent + :visual 0 + :value-mask 0 + :override-redirect 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:ewmh:set-_NET_WM_NAME + :window new-owner :data "EXWM: exwm--wmsn-window")) + (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:SetSelectionOwner + :selection xcb:Atom:WM_S0 + :owner new-owner + :time xcb:Time:CurrentTime)) + (with-slots (owner) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetSelectionOwner + :selection xcb:Atom:WM_S0)) + (unless (eq owner new-owner) + (error "Could not acquire ownership of WM selection"))) + ;; Wait for the other window manager to terminate. + (when (/= owner xcb:Window:None) + (let (reply) + (cl-dotimes (i exwm--wmsn-acquire-timeout) + (setq reply (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry :drawable owner))) + (when (not reply) + (cl-return)) + (message "Waiting for other window manager to quit... %ds" i) + (sleep-for 1)) + (when reply + (error "Other window manager did not release selection in time")))) + ;; announce + (let* ((cmd (make-instance 'xcb:ClientMessageData + :data32 (vector xcb:Time:CurrentTime + xcb:Atom:WM_S0 + new-owner + 0 + 0))) + (cm (make-instance 'xcb:ClientMessage + :window exwm--root + :format 32 + :type xcb:Atom:MANAGER + :data cmd)) + (se (make-instance 'xcb:SendEvent + :propagate 0 + :destination exwm--root + :event-mask xcb:EventMask:NoEvent + :event (xcb:marshal cm exwm--connection)))) + (xcb:+request exwm--connection se)) + (setq exwm--wmsn-window new-owner)))) + +;;;###autoload +(cl-defun exwm-init (&optional frame) + "Initialize EXWM. +FRAME, if given, indicates the X display EXWM should manage." + (interactive) + (exwm--log "%s" frame) + (if frame + ;; The frame might not be selected if it's created by emacslicnet. + (select-frame-set-input-focus frame) + (setq frame (selected-frame))) + (when (not (eq 'x (framep frame))) + (message "[EXWM] Not running under X environment") + (cl-return-from exwm-init)) + (when exwm--connection + (exwm--log "EXWM already running") + (cl-return-from exwm-init)) + (condition-case err + (progn + (exwm-enable 'undo) ;never initialize again + (setq exwm--terminal (frame-terminal frame)) + (setq exwm--connection (xcb:connect)) + (set-process-query-on-exit-flag (slot-value exwm--connection 'process) + nil) ;prevent query message on exit + (setq exwm--root + (slot-value (car (slot-value + (xcb:get-setup exwm--connection) 'roots)) + 'root)) + ;; Initialize ICCCM/EWMH support + (xcb:icccm:init exwm--connection t) + (xcb:ewmh:init exwm--connection t) + ;; Try to register window manager selection. + (exwm--wmsn-acquire exwm-replace) + (when (xcb:+request-checked+request-check exwm--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--root + :value-mask xcb:CW:EventMask + :event-mask + xcb:EventMask:SubstructureRedirect)) + (error "Other window manager is running")) + ;; Disable some features not working well with EXWM + (setq use-dialog-box nil + confirm-kill-emacs #'exwm--confirm-kill-emacs) + (advice-add 'save-buffers-kill-terminal + :before-while #'exwm--confirm-kill-terminal) + ;; Clean up if the terminal is deleted. + (add-hook 'delete-terminal-functions 'exwm--on-delete-terminal) + (exwm--lock) + (exwm--init-icccm-ewmh) + (exwm-layout--init) + (exwm-floating--init) + (exwm-manage--init) + (exwm-workspace--init) + (exwm-input--init) + (exwm--unlock) + (exwm-workspace--post-init) + (exwm-input--post-init) + (run-hooks 'exwm-init-hook) + ;; Manage existing windows + (exwm-manage--scan)) + (user-error) + ((quit error) + (exwm-exit) + ;; Rethrow error + (warn "[EXWM] EXWM fails to start (%s: %s)" (car err) (cdr err))))) + + +;;;###autoload +(defun exwm-exit () + "Exit EXWM." + (interactive) + (exwm--log) + (run-hooks 'exwm-exit-hook) + (setq confirm-kill-emacs nil) + ;; Exit modules. + (when exwm--connection + (exwm-input--exit) + (exwm-manage--exit) + (exwm-workspace--exit) + (exwm-floating--exit) + (exwm-layout--exit) + (xcb:flush exwm--connection) + (xcb:disconnect exwm--connection)) + (setq exwm--connection nil) + (setq exwm--terminal nil) + (exwm--log "Exited")) + +;;;###autoload +(defun exwm-enable (&optional undo) + "Enable/Disable EXWM." + (exwm--log "%s" undo) + (pcase undo + (`undo ;prevent reinitialization + (remove-hook 'window-setup-hook #'exwm-init) + (remove-hook 'after-make-frame-functions #'exwm-init)) + (`undo-all ;attempt to revert everything + (remove-hook 'window-setup-hook #'exwm-init) + (remove-hook 'after-make-frame-functions #'exwm-init) + (remove-hook 'kill-emacs-hook #'exwm--server-stop) + (dolist (i exwm-blocking-subrs) + (advice-remove i #'exwm--server-eval-at))) + (_ ;enable EXWM + (setq frame-resize-pixelwise t ;mandatory; before init + window-resize-pixelwise t) + ;; Ignore unrecognized command line arguments. This can be helpful + ;; when EXWM is launched by some session manager. + (push #'vector command-line-functions) + ;; In case EXWM is to be started from a graphical Emacs instance. + (add-hook 'window-setup-hook #'exwm-init t) + ;; In case EXWM is to be started with emacsclient. + (add-hook 'after-make-frame-functions #'exwm-init t) + ;; Manage the subordinate Emacs server. + (add-hook 'kill-emacs-hook #'exwm--server-stop) + (dolist (i exwm-blocking-subrs) + (advice-add i :around #'exwm--server-eval-at))))) + +(defun exwm--server-stop () + "Stop the subordinate Emacs server." + (exwm--log) + (when exwm--server-process + (when (process-live-p exwm--server-process) + (cl-loop + initially (signal-process exwm--server-process 'TERM) + while (process-live-p exwm--server-process) + repeat (* 10 exwm--server-timeout) + do (sit-for 0.1))) + (delete-process exwm--server-process) + (setq exwm--server-process nil))) + +(defun exwm--server-eval-at (function &rest args) + "Wrapper of `server-eval-at' used to advice subrs. +FUNCTION is the function to be evaluated, ARGS are the arguments." + ;; Start the subordinate Emacs server if it's not alive + (exwm--log "%s %s" function args) + (unless (server-running-p exwm--server-name) + (when exwm--server-process (delete-process exwm--server-process)) + (setq exwm--server-process + (start-process exwm--server-name + nil + (car command-line-args) ;The executable file + "-d" (frame-parameter nil 'display) + "-Q" + (concat "--fg-daemon=" exwm--server-name) + "--eval" + ;; Create an invisible frame + "(make-frame '((window-system . x) (visibility)))")) + (while (not (server-running-p exwm--server-name)) + (sit-for 0.001))) + (server-eval-at + exwm--server-name + `(progn (select-frame (car (frame-list))) + (let ((result ,(nconc (list (make-symbol (subr-name function))) + args))) + (pcase (type-of result) + ;; Return the name of a buffer + (`buffer (buffer-name result)) + ;; We blindly convert all font objects to their XLFD names. This + ;; might cause problems of course, but it still has a chance to + ;; work (whereas directly passing font objects would merely + ;; raise errors). + ((or `font-entity `font-object `font-spec) + (font-xlfd-name result)) + ;; Passing following types makes little sense + ((or `compiled-function `finalizer `frame `hash-table `marker + `overlay `process `window `window-configuration)) + ;; Passing the name of a subr + (`subr (make-symbol (subr-name result))) + ;; For other types, return the value as-is. + (t result)))))) + +(defun exwm--confirm-kill-terminal (&optional _) + "Confirm before killing terminal." + ;; This is invoked instead of `save-buffers-kill-emacs' (C-x C-c) on client + ;; frames. + (if (exwm--terminal-p) + (exwm--confirm-kill-emacs "Kill terminal?") + t)) + +(defun exwm--confirm-kill-emacs (prompt &optional force) + "Confirm before exiting Emacs. +PROMPT a reason to present to the user. +If FORCE is nil, ask the user for confirmation. +If FORCE is the symbol `no-check', ask if there are unsaved buffers. +If FORCE is any other non-nil value, force killing of Emacs." + (exwm--log) + (when (cond + ((and force (not (eq force 'no-check))) + ;; Force killing Emacs. + t) + ((or (eq force 'no-check) (not exwm--id-buffer-alist)) + ;; Check if there's any unsaved file. + (pcase (catch 'break + (let ((kill-emacs-query-functions + (append kill-emacs-query-functions + (list (lambda () + (throw 'break 'break)))))) + (save-buffers-kill-emacs))) + (`break (y-or-n-p prompt)) + (x x))) + (t + (yes-or-no-p (format "[EXWM] %d X window(s) will be destroyed. %s" + (length exwm--id-buffer-alist) prompt)))) + ;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs + ;; frames are unmapped so that errors (if any) can be visible. + (if (memq #'server-force-stop kill-emacs-hook) + (progn + (setq kill-emacs-hook (delq #'server-force-stop kill-emacs-hook)) + (run-hooks 'kill-emacs-hook) + (setq kill-emacs-hook (list #'server-force-stop))) + (run-hooks 'kill-emacs-hook) + (setq kill-emacs-hook nil)) + ;; Exit each module, destroying all resources created by this connection. + (exwm-exit) + ;; Set the return value. + t)) + + + +(provide 'exwm) + +;;; exwm.el ends here diff --git a/third_party/exwm/xinitrc b/third_party/exwm/xinitrc new file mode 100644 index 000000000000..591e4199144f --- /dev/null +++ b/third_party/exwm/xinitrc @@ -0,0 +1,20 @@ +# Disable access control for the current user. +xhost +SI:localuser:$USER + +# Make Java applications aware this is a non-reparenting window manager. +export _JAVA_AWT_WM_NONREPARENTING=1 + +# Set default cursor. +xsetroot -cursor_name left_ptr + +# Set keyboard repeat rate. +xset r rate 200 60 + +# Uncomment the following block to use the exwm-xim module. +#export XMODIFIERS=@im=exwm-xim +#export GTK_IM_MODULE=xim +#export QT_IM_MODULE=xim +#export CLUTTER_IM_MODULE=xim + +# Finally start Emacs +exec emacs |