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