Mirrors/exwm
2
0
Fork 0
mirror of https://github.com/ch11ng/exwm.git synced 2024-11-23 11:47:58 +01:00
Code Issues Projects Releases Packages Wiki Activity

Moved to https://github.com/emacs-exwm/exwm

Browse source
This commit is contained in:
Adrián Medraño Calvo 2024-02-05 00:00:00 +00:00
parent 798dc60a9b
commit 4755cb6ee1
18 changed files with 19 additions and 9724 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.elpaignore
View file

@ -1 +0,0 @@
README.md

10
.github/issue_template.md vendored Normal file
View file

@ -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.

3
.gitignore vendored
View file

@ -1,3 +0,0 @@
*.elc
*-pkg.el
*-autoloads.el

674
LICENSE
View file

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

27
README.md
View file

@ -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).

199
exwm-background.el
View file

@ -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 <steven@stebalien.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module adds X background color setting support to EXWM.
;; To use this module, load and enable it as follows:
;; (require 'exwm-background)
;; (exwm-background-enable)
;;
;; By default, this will apply the theme's background color. However, that
;; color can be customized via the `exwm-background-color' setting.
;;; Code:
(require 'exwm-core)
(defcustom exwm-background-color nil
"Background color for Xorg."
:type '(choice
(color :tag "Background Color")
(const :tag "Default" nil))
:group 'exwm
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default-toplevel-value symbol value)
(exwm-background--update)))
(defconst exwm-background--properties '("_XROOTPMAP_ID" "_XSETROOT_ID" "ESETROOT_PMAP_ID")
"The background properties to set.
We can't need to set these so that compositing window managers can correctly display the background
color.")
(defvar exwm-background--connection nil
"The X connection used for setting the background.
We use a separate connection as other background-setting tools may kill this connection when they
replace it.")
(defvar exwm-background--pixmap nil
"Cached background pixmap.")
(defvar exwm-background--atoms nil
"Cached background atoms.")
(defun exwm-background--update (&rest _)
"Update the EXWM background."
;; Always reconnect as any tool that sets the background may have disconnected us (to force X to
;; free resources).
(exwm-background--connect)
(let ((gc (xcb:generate-id exwm-background--connection))
(color (exwm--color->pixel (or exwm-background-color
(face-background 'default)))))
;; Fill the pixmap.
(xcb:+request exwm-background--connection
(make-instance 'xcb:CreateGC
:cid gc :drawable exwm-background--pixmap
:value-mask (logior xcb:GC:Foreground
xcb:GC:GraphicsExposures)
:foreground color
:graphics-exposures 0))
(xcb:+request exwm-background--connection
(make-instance 'xcb:PolyFillRectangle
:gc gc :drawable exwm-background--pixmap
:rectangles
(list
(make-instance
'xcb:RECTANGLE
:x 0 :y 0 :width 1 :height 1))))
(xcb:+request exwm-background--connection (make-instance 'xcb:FreeGC :gc gc)))
;; Reapply it to force an update (also clobber anyone else who may have set it).
(xcb:+request exwm-background--connection
(make-instance 'xcb:ChangeWindowAttributes
:window exwm--root
:value-mask xcb:CW:BackPixmap
:background-pixmap exwm-background--pixmap))
(let (old)
;; Collect old pixmaps so we can kill other background clients (all the background setting tools
;; seem to do this).
(dolist (atom exwm-background--atoms)
(when-let* ((reply (xcb:+request-unchecked+reply exwm-background--connection
(make-instance 'xcb:GetProperty
:delete 0
:window exwm--root
:property atom
:type xcb:Atom:PIXMAP
:long-offset 0
:long-length 1)))
(value (vconcat (slot-value reply 'value)))
((length= value 4))
(pixmap (funcall (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4)
value 0))
((not (or (= pixmap exwm-background--pixmap)
(member pixmap old)))))
(push pixmap old)))
;; Change the background.
(dolist (atom exwm-background--atoms)
(xcb:+request exwm-background--connection
(make-instance 'xcb:ChangeProperty
:window exwm--root
:property atom
:type xcb:Atom:PIXMAP
:format 32
:mode xcb:PropMode:Replace
:data-len 1
:data
(funcall (if xcb:lsb
#'xcb:-pack-u4-lsb
#'xcb:-pack-u4)
exwm-background--pixmap))))
;; Kill the old background clients.
(dolist (pixmap old)
(xcb:+request exwm-background--connection
(make-instance 'xcb:KillClient :resource pixmap))))
(xcb:flush exwm-background--connection))
(defun exwm-background--connected-p ()
(and exwm-background--connection
(process-live-p (slot-value exwm-background--connection 'process))))
(defun exwm-background--connect ()
(unless (exwm-background--connected-p)
(setq exwm-background--connection (xcb:connect))
;;prevent query message on exit
(set-process-query-on-exit-flag (slot-value exwm-background--connection 'process) nil)
;; Intern the background property atoms.
(setq exwm-background--atoms
(mapcar
(lambda (prop) (exwm--intern-atom prop exwm-background--connection))
exwm-background--properties))
;; Create the pixmap.
(setq exwm-background--pixmap (xcb:generate-id exwm-background--connection))
(xcb:+request exwm-background--connection
(make-instance 'xcb:CreatePixmap
:depth
(slot-value
(xcb:+request-unchecked+reply exwm-background--connection
(make-instance 'xcb:GetGeometry :drawable exwm--root))
'depth)
:pid exwm-background--pixmap
:drawable exwm--root
:width 1 :height 1))))
(defun exwm-background--init ()
"Initialize background module."
(exwm--log)
(add-hook 'enable-theme-functions 'exwm-background--update)
(add-hook 'disable-theme-functions 'exwm-background--update)
(exwm-background--update))
(defun exwm-background--exit ()
"Uninitialize the background module."
(exwm--log)
(remove-hook 'enable-theme-functions 'exwm-background--update)
(remove-hook 'disable-theme-functions 'exwm-background--update)
(when (and exwm-background--connection
(slot-value exwm-background--connection 'connected))
(xcb:disconnect exwm-background--connection))
(setq exwm-background--pixmap nil
exwm-background--connection nil
exwm-background--atoms nil))
(defun exwm-background-enable ()
"Enable background support for EXWM."
(exwm--log)
(add-hook 'exwm-init-hook #'exwm-background--init)
(add-hook 'exwm-exit-hook #'exwm-background--exit))
(provide 'exwm-background)
;;; exwm-background.el ends here

131
exwm-config.el
View file

@ -1,131 +0,0 @@
;;; exwm-config.el --- Predefined configurations -*- lexical-binding: t -*-
;; Copyright (C) 2015-2024 Free Software Foundation, Inc.
;; Author: Chris Feng <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module contains typical (yet minimal) configurations of EXWM.
;;; Code:
(require 'exwm)
(require 'ido)
(define-obsolete-function-alias 'exwm-config-default
#'exwm-config-example "27.1")
(defun exwm-config-example ()
"Default configuration of EXWM."
;; Set the initial workspace number.
(unless (get 'exwm-workspace-number 'saved-value)
(setq exwm-workspace-number 4))
;; Make class name the buffer name
(add-hook 'exwm-update-class-hook
(lambda ()
(exwm-workspace-rename-buffer exwm-class-name)))
;; Global keybindings.
(unless (get 'exwm-input-global-keys 'saved-value)
(setq exwm-input-global-keys
`(
;; 's-r': Reset (to line-mode).
([?\s-r] . exwm-reset)
;; 's-w': Switch workspace.
([?\s-w] . exwm-workspace-switch)
;; 's-&': Launch application.
([?\s-&] . (lambda (command)
(interactive (list (read-shell-command "$ ")))
(start-process-shell-command command nil command)))
;; 's-N': Switch to certain workspace.
,@(mapcar (lambda (i)
`(,(kbd (format "s-%d" i)) .
(lambda ()
(interactive)
(exwm-workspace-switch-create ,i))))
(number-sequence 0 9)))))
;; Line-editing shortcuts
(unless (get 'exwm-input-simulation-keys 'saved-value)
(setq exwm-input-simulation-keys
'(([?\C-b] . [left])
([?\C-f] . [right])
([?\C-p] . [up])
([?\C-n] . [down])
([?\C-a] . [home])
([?\C-e] . [end])
([?\M-v] . [prior])
([?\C-v] . [next])
([?\C-d] . [delete])
([?\C-k] . [S-end delete]))))
;; Enable EXWM
(exwm-enable)
;; Configure Ido
(exwm-config-ido)
;; Other configurations
(exwm-config-misc))
(defun exwm-config--fix/ido-buffer-window-other-frame ()
"Fix `ido-buffer-window-other-frame'."
(defalias 'exwm-config-ido-buffer-window-other-frame
(symbol-function #'ido-buffer-window-other-frame))
(defun ido-buffer-window-other-frame (buffer)
"This is a version redefined by EXWM.
You can find the original one at `exwm-config-ido-buffer-window-other-frame'."
(with-current-buffer (window-buffer (selected-window))
(if (and (derived-mode-p 'exwm-mode)
exwm--floating-frame)
;; Switch from a floating frame.
(with-current-buffer buffer
(if (and (derived-mode-p 'exwm-mode)
exwm--floating-frame
(eq exwm--frame exwm-workspace--current))
;; Switch to another floating frame.
(frame-root-window exwm--floating-frame)
;; Do not switch if the buffer is not on the current workspace.
(or (get-buffer-window buffer exwm-workspace--current)
(selected-window))))
(with-current-buffer buffer
(when (derived-mode-p 'exwm-mode)
(if (eq exwm--frame exwm-workspace--current)
(when exwm--floating-frame
;; Switch to a floating frame on the current workspace.
(frame-selected-window exwm--floating-frame))
;; Do not switch to exwm-mode buffers on other workspace (which
;; won't work unless `exwm-layout-show-all-buffers' is set)
(unless exwm-layout-show-all-buffers
(selected-window)))))))))
(defun exwm-config-ido ()
"Configure Ido to work with EXWM."
(ido-mode 1)
(add-hook 'exwm-init-hook #'exwm-config--fix/ido-buffer-window-other-frame))
(defun exwm-config-misc ()
"Other configurations."
;; Make more room
(menu-bar-mode -1)
(tool-bar-mode -1)
(scroll-bar-mode -1)
(fringe-mode 1))
(provide 'exwm-config)
;;; exwm-config.el ends here

408
exwm-core.el
View file

@ -1,408 +0,0 @@
;;; exwm-core.el --- Core definitions -*- lexical-binding: t -*-
;; Copyright (C) 2015-2024 Free Software Foundation, Inc.
;; Author: Chris Feng <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module includes core definitions of variables, macros, functions, etc
;; shared by various other modules.
;;; Code:
(require 'kmacro)
(require 'xcb)
(require 'xcb-icccm)
(require 'xcb-ewmh)
(require 'xcb-debug)
(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 (<X window ID> . <Emacs buffer>).")
(defvar exwm--root nil "Root window.")
(defvar exwm-input--global-prefix-keys)
(defvar exwm-input--simulation-keys)
(defvar exwm-input-line-mode-passthrough)
(defvar exwm-input-prefix-keys)
(declare-function exwm-input--fake-key "exwm-input.el" (event))
(declare-function exwm-input--on-KeyPress-line-mode "exwm-input.el"
(key-press raw-data))
(declare-function exwm-floating-hide "exwm-floating.el")
(declare-function exwm-floating-toggle-floating "exwm-floating.el")
(declare-function exwm-input-release-keyboard "exwm-input.el")
(declare-function exwm-input-send-next-key "exwm-input.el" (times))
(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id))
(declare-function exwm-layout-toggle-mode-line "exwm-layout.el")
(declare-function exwm-manage--kill-buffer-query-function "exwm-manage.el")
(declare-function exwm-workspace-move-window "exwm-workspace.el"
(frame-or-index &optional id))
(define-minor-mode exwm-debug
"Debug-logging enabled if non-nil."
:global t
:group 'exwm-debug)
(defmacro exwm--debug (&rest forms)
"Evaluate FORMS if mode `exwm-debug' is active."
(when exwm-debug `(progn ,@forms)))
(defmacro exwm--log (&optional format-string &rest objects)
"Emit a message prepending the name of the function being executed.
FORMAT-STRING is a string specifying the message to output, as in
`format'. The OBJECTS arguments specify the substitutions."
(unless format-string (setq format-string ""))
`(when exwm-debug
(xcb-debug:message ,(concat "%s%s:\t" format-string "\n")
(if exwm-debug-log-time-function
(funcall exwm-debug-log-time-function)
"")
(xcb-debug:compile-time-function-name)
,@objects)
nil))
(defsubst exwm--id->buffer (id)
"X window ID => Emacs buffer."
(declare (indent defun))
(cdr (assoc id exwm--id-buffer-alist)))
(defsubst exwm--buffer->id (buffer)
"Emacs buffer BUFFER => X window ID."
(declare (indent defun))
(car (rassoc buffer exwm--id-buffer-alist)))
(defun exwm--lock (&rest _args)
"Lock (disable all events)."
(exwm--log)
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window exwm--root
:value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:NoEvent))
(xcb:flush exwm--connection))
(defun exwm--unlock (&rest _args)
"Unlock (enable all events)."
(exwm--log)
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window exwm--root
:value-mask xcb:CW:EventMask
:event-mask (eval-when-compile
(logior xcb:EventMask:SubstructureRedirect
xcb:EventMask:StructureNotify))))
(xcb:flush exwm--connection))
(defun exwm--set-geometry (xwin x y width height)
"Set the geometry of X window XWIN to WIDTHxHEIGHT+X+Y.
Nil can be passed as placeholder."
(exwm--log "Setting #x%x to %sx%s+%s+%s" xwin width height x y)
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window xwin
:value-mask (logior (if x xcb:ConfigWindow:X 0)
(if y xcb:ConfigWindow:Y 0)
(if width xcb:ConfigWindow:Width 0)
(if height xcb:ConfigWindow:Height 0))
:x x :y y :width width :height height)))
(defun exwm--intern-atom (atom &optional conn)
"Intern X11 ATOM.
If CONN is non-nil, use it instead of the value of the variable
`exwm--connection'."
(slot-value (xcb:+request-unchecked+reply (or conn exwm--connection)
(make-instance 'xcb:InternAtom
:only-if-exists 0
:name-len (length atom)
:name atom))
'atom))
(defmacro exwm--defer (secs function &rest args)
"Defer the execution of FUNCTION.
The action is to call FUNCTION with arguments ARGS. If Emacs is not idle,
defer the action until Emacs is idle. Otherwise, defer the action until at
least SECS seconds later."
`(run-with-idle-timer (+ (float-time (or (current-idle-time)
(seconds-to-time (- ,secs))))
,secs)
nil
,function
,@args))
(defsubst exwm--terminal-p (&optional frame)
"Return t when FRAME's terminal is EXWM's terminal.
If FRAME is null, use selected frame."
(declare (indent defun))
(eq exwm--terminal (frame-terminal frame)))
(defun exwm--get-client-event-mask ()
"Return event mask set on all managed windows."
(logior xcb:EventMask:StructureNotify
xcb:EventMask:PropertyChange
(if mouse-autoselect-window
xcb:EventMask:EnterWindow 0)))
(defun exwm--color->pixel (color)
"Convert COLOR to PIXEL (index in TrueColor colormap)."
(when (and color
(eq (x-display-visual-class) 'true-color))
(let ((rgb (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

781
exwm-floating.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module deals with the conversion between floating and non-floating
;; states and implements moving/resizing operations on floating windows.
;;; Code:
(require 'xcb-cursor)
(require 'exwm-core)
(defgroup exwm-floating nil
"Floating."
: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

1271
exwm-input.el
View file

File diff suppressed because it is too large Load diff

631
exwm-layout.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module is responsible for keeping X client window properly displayed.
;;; Code:
(require 'exwm-core)
(defgroup exwm-layout nil
"Layout."
: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

820
exwm-manage.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is the fundamental module of EXWM that deals with window management.
;;; Code:
(require 'exwm-core)
(defgroup exwm-manage nil
"Manage."
: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 <Xm/MwmUtil.h> for more details)
;; It's currently only used in 'exwm-manage' module
(defvar exwm-manage--_MOTIF_WM_HINTS nil "_MOTIF_WM_HINTS atom.")
(defvar exwm-manage--desktop nil "The desktop X window.")
(defvar exwm-manage--frame-outer-id-list nil
"List of window-outer-id's of all frames.")
(defvar exwm-manage--ping-lock nil
"Non-nil indicates EXWM is pinging a window.")
(defvar exwm-input--skip-buffer-list-update)
(defvar exwm-input-prefix-keys)
(defvar exwm-workspace--current)
(defvar exwm-workspace--id-struts-alist)
(defvar exwm-workspace--list)
(defvar exwm-workspace--switch-history-outdated)
(defvar exwm-workspace-current-index)
(declare-function exwm--update-class "exwm.el" (id &optional force))
(declare-function exwm--update-hints "exwm.el" (id &optional force))
(declare-function exwm--update-normal-hints "exwm.el" (id &optional force))
(declare-function exwm--update-protocols "exwm.el" (id &optional force))
(declare-function exwm--update-struts "exwm.el" (id))
(declare-function exwm--update-title "exwm.el" (id))
(declare-function exwm--update-transient-for "exwm.el" (id &optional force))
(declare-function exwm--update-desktop "exwm.el" (id &optional force))
(declare-function exwm--update-window-type "exwm.el" (id &optional force))
(declare-function exwm-floating--set-floating "exwm-floating.el" (id))
(declare-function exwm-floating--unset-floating "exwm-floating.el" (id))
(declare-function exwm-input-grab-keyboard "exwm-input.el" (&optional id))
(declare-function exwm-input-release-keyboard "exwm-input.el" (&optional id))
(declare-function exwm-input-set-local-simulation-keys "exwm-input.el")
(declare-function exwm-layout--fullscreen-p "exwm-layout.el" ())
(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))
(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id))
(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame))
(declare-function exwm-workspace--position "exwm-workspace.el" (frame))
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--update-struts "exwm-workspace.el" ())
(declare-function exwm-workspace--update-workareas "exwm-workspace.el" ())
(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame))
(defun exwm-manage--update-geometry (id &optional force)
"Update geometry of X window ID.
Override current geometry if FORCE is non-nil."
(exwm--log "id=#x%x" id)
(with-current-buffer (exwm--id->buffer id)
(unless (and exwm--geometry (not force))
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry :drawable id))))
(setq exwm--geometry
(or reply
;; Provide a reasonable fallback value.
(make-instance 'xcb:RECTANGLE
:x 0
:y 0
:width (/ (x-display-pixel-width) 2)
:height (/ (x-display-pixel-height) 2))))))))
(defun exwm-manage--update-ewmh-state (id)
"Update _NET_WM_STATE of X window ID."
(exwm--log "id=#x%x" id)
(with-current-buffer (exwm--id->buffer id)
(unless exwm--ewmh-state
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:ewmh:get-_NET_WM_STATE
:window id))))
(when reply
(setq exwm--ewmh-state (append (slot-value reply 'value) nil)))))))
(defun exwm-manage--update-mwm-hints (id &optional force)
"Update _MOTIF_WM_HINTS of X window ID.
Override current hinds if FORCE is non-nil."
(exwm--log "id=#x%x" id)
(with-current-buffer (exwm--id->buffer id)
(unless (and (not exwm--mwm-hints-decorations) (not force))
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:icccm:-GetProperty
:window id
:property exwm-manage--_MOTIF_WM_HINTS
:type exwm-manage--_MOTIF_WM_HINTS
:long-length 5))))
(when reply
;; Check MotifWmHints.decorations.
(with-slots (value) reply
(setq value (append value nil))
(when (and value
;; See <Xm/MwmUtil.h> for fields definitions.
(/= 0 (logand
(elt value 0) ;MotifWmHints.flags
2)) ;MWM_HINTS_DECORATIONS
(= 0
(elt value 2))) ;MotifWmHints.decorations
(setq exwm--mwm-hints-decorations nil))))))))
(defun exwm-manage--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

377
exwm-randr.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module adds RandR support for EXWM. Currently it requires external
;; tools such as xrandr(1) to properly configure RandR first. This
;; dependency may be removed in the future, but more work is needed before
;; that.
;; To use this module, load, enable it and configure
;; `exwm-randr-workspace-monitor-plist' and `exwm-randr-screen-change-hook'
;; as follows:
;;
;; (require 'exwm-randr)
;; (setq exwm-randr-workspace-monitor-plist '(0 "VGA1"))
;; (add-hook 'exwm-randr-screen-change-hook
;; (lambda ()
;; (start-process-shell-command
;; "xrandr" nil "xrandr --output VGA1 --left-of LVDS1 --auto")))
;; (exwm-randr-enable)
;;
;; With above lines, workspace 0 should be assigned to the output named "VGA1",
;; staying at the left of other workspaces on the output "LVDS1". Please refer
;; to xrandr(1) for the configuration of RandR.
;; References:
;; + RandR (http://www.x.org/archive/X11R7.7/doc/randrproto/randrproto.txt)
;;; Code:
(require 'xcb-randr)
(require 'exwm-core)
(require 'exwm-workspace)
(declare-function x-get-atom-name "C source code" (VALUE &optional FRAME))
(defgroup exwm-randr nil
"RandR."
: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

702
exwm-systemtray.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module adds system tray support for EXWM.
;; To use this module, load and enable it as follows:
;; (require 'exwm-systemtray)
;; (exwm-systemtray-enable)
;;; Code:
(require 'xcb-ewmh)
(require 'xcb-icccm)
(require 'xcb-xembed)
(require 'xcb-systemtray)
(require 'exwm-core)
(require 'exwm-workspace)
(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame))
(defclass exwm-systemtray--icon ()
((width :initarg :width)
(height :initarg :height)
(visible :initarg :visible))
:documentation "Attributes of a system tray icon.")
(defclass xcb:systemtray:-ClientMessage
(xcb:icccm:--ClientMessage xcb:ClientMessage)
((format :initform 32)
(type :initform 'xcb:Atom:MANAGER)
(time :initarg :time :type xcb:TIMESTAMP) ;new slot
(selection :initarg :selection :type xcb:ATOM) ;new slot
(owner :initarg :owner :type xcb:WINDOW)) ;new slot
:documentation "A systemtray client message.")
(defgroup exwm-systemtray nil
"System tray."
: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

1769
exwm-workspace.el
View file

File diff suppressed because it is too large Load diff

810
exwm-xim.el
View file

@ -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 <chris.w.feng@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module adds XIM support for EXWM and allows sending characters
;; generated by any Emacs's builtin input method (info node `Input Methods')
;; to X windows.
;; This module is essentially an X input method server utilizing Emacs as
;; its backend. It talks with X windows through the XIM protocol. The XIM
;; protocol is quite flexible by itself, stating that an implementation can
;; create network connections of various types as well as make use of an
;; existing X connection for communication, and that an IM server may
;; support multiple transport versions, various input styles and several
;; event flow modals, etc. Here we only make choices that are most popular
;; among other IM servers and more importantly, practical for Emacs to act
;; as an IM server:
;;
;; + Packets are transported on top of an X connection like most IMEs.
;; + Only transport version 0.0 (i.e. only-CM & Property-with-CM) is
;; supported (same as "IM Server Developers Kit", adopted by most IMEs).
;; + Only support static event flow, on-demand-synchronous method.
;; + Only "root-window" input style is supported.
;; To use this module, first load and enable it as follows:
;;
;; (require 'exwm-xim)
;; (exwm-xim-enable)
;;
;; A keybinding for `toggle-input-method' is probably required to turn on &
;; off an input method (default to `default-input-method'). It's bound to
;; 'C-\' by default and can be made reachable when working with X windows:
;;
;; (push ?\C-\\ exwm-input-prefix-keys)
;;
;; It's also required (and error-prone) to setup environment variables to
;; make applications actually use this input method. Typically the
;; following lines should be inserted into '~/.xinitrc'.
;;
;; export XMODIFIERS=@im=exwm-xim
;; export GTK_IM_MODULE=xim
;; export QT_IM_MODULE=xim
;; export CLUTTER_IM_MODULE=xim
;; References:
;; + XIM (http://www.x.org/releases/X11R7.6/doc/libX11/specs/XIM/xim.html)
;; + IMdkit (http://xorg.freedesktop.org/archive/unsupported/lib/IMdkit/)
;; + UIM (https://github.com/uim/uim)
;;; Code:
(require 'cl-lib)
(require 'xcb-keysyms)
(require 'xcb-xim)
(require 'exwm-core)
(require 'exwm-input)
(defconst exwm-xim--locales
"@locale=\
aa,af,ak,am,an,anp,ar,as,ast,ayc,az,be,bem,ber,bg,bhb,bho,bn,bo,br,brx,bs,byn,\
ca,ce,cmn,crh,cs,csb,cv,cy,da,de,doi,dv,dz,el,en,es,et,eu,fa,ff,fi,fil,fo,fr,\
fur,fy,ga,gd,gez,gl,gu,gv,ha,hak,he,hi,hne,hr,hsb,ht,hu,hy,ia,id,ig,ik,is,it,\
iu,iw,ja,ka,kk,kl,km,kn,ko,kok,ks,ku,kw,ky,lb,lg,li,li,lij,lo,lt,lv,lzh,mag,\
mai,mg,mhr,mi,mk,ml,mn,mni,mr,ms,mt,my,nan,nb,nds,ne,nhn,niu,nl,nn,nr,nso,oc,\
om,or,os,pa,pa,pap,pl,ps,pt,quz,raj,ro,ru,rw,sa,sat,sc,sd,se,shs,si,sid,sk,sl,\
so,sq,sr,ss,st,sv,sw,szl,ta,tcy,te,tg,th,the,ti,tig,tk,tl,tn,tr,ts,tt,ug,uk,\
unm,ur,uz,ve,vi,wa,wae,wal,wo,xh,yi,yo,yue,zh,zu,\
C,no"
"All supported locales (stolen from glibc).")
(defconst exwm-xim--default-error
(make-instance 'xim:error
:im-id 0
:ic-id 0
:flag xim:error-flag:invalid-both
:error-code xim:error-code:bad-something
:length 0
:type 0
:detail nil)
"Default error returned to clients.")
(defconst exwm-xim--default-im-attrs
(list (make-instance 'xim:XIMATTR
:id 0
:type xim:ATTRIBUTE-VALUE-TYPE:xim-styles
:length (length xlib:XNQueryInputStyle)
:attribute xlib:XNQueryInputStyle))
"Default IM attrs returned to clients.")
(defconst exwm-xim--default-ic-attrs
(list (make-instance 'xim:XICATTR
:id 0
:type xim:ATTRIBUTE-VALUE-TYPE:long-data
:length (length xlib:XNInputStyle)
:attribute xlib:XNInputStyle)
(make-instance 'xim:XICATTR
:id 1
:type xim:ATTRIBUTE-VALUE-TYPE:window
:length (length xlib:XNClientWindow)
:attribute xlib:XNClientWindow)
;; Required by e.g. xterm.
(make-instance 'xim:XICATTR
:id 2
:type xim:ATTRIBUTE-VALUE-TYPE:window
:length (length xlib:XNFocusWindow)
:attribute xlib:XNFocusWindow))
"Default IC attrs returned to clients.")
(defconst exwm-xim--default-styles
(make-instance 'xim:XIMStyles
:number nil
:styles (list (logior xlib:XIMPreeditNothing
xlib:XIMStatusNothing)))
"Default styles: root-window, i.e. no preediting or status display support.")
(defconst exwm-xim--default-attributes
(list (make-instance 'xim:XIMATTRIBUTE
:id 0
:length nil
:value exwm-xim--default-styles))
"Default IM/IC attributes returned to clients.")
(defvar exwm-xim--conn nil
"The X connection for initiating other XIM connections.")
(defvar exwm-xim--event-xwin nil
"X window for initiating new XIM connections.")
(defvar exwm-xim--server-client-plist '(nil nil)
"Plist mapping server window to [X connection, client window, byte-order].")
(defvar exwm-xim--client-server-plist '(nil nil)
"Plist mapping client window to server window.")
(defvar exwm-xim--property-index 0 "For generating a unique property name.")
(defvar exwm-xim--im-id 0 "Last IM ID.")
(defvar exwm-xim--ic-id 0 "Last IC ID.")
;; X11 atoms.
(defvar exwm-xim--@server nil)
(defvar exwm-xim--LOCALES nil)
(defvar exwm-xim--TRANSPORT nil)
(defvar exwm-xim--XIM_SERVERS nil)
(defvar exwm-xim--_XIM_PROTOCOL nil)
(defvar exwm-xim--_XIM_XCONNECT nil)
(defvar exwm-xim-buffer-p nil
"Whether current buffer is used by exwm-xim.")
(make-variable-buffer-local 'exwm-xim-buffer-p)
(defun exwm-xim--on-SelectionRequest (data _synthetic)
"Handle SelectionRequest events on IMS window.
DATA contains unmarshalled SelectionRequest event data.
Such events would be received when clients query for LOCALES or TRANSPORT."
(exwm--log)
(let ((evt (make-instance 'xcb:SelectionRequest))
value fake-event)
(xcb:unmarshal evt data)
(with-slots (time requestor selection target property) evt
(setq value (cond ((= target exwm-xim--LOCALES)
;; Return supported locales.
exwm-xim--locales)
((= target exwm-xim--TRANSPORT)
;; Use XIM over an X connection.
"@transport=X/")))
(when value
;; Change the property.
(xcb:+request exwm-xim--conn
(make-instance 'xcb:ChangeProperty
:mode xcb:PropMode:Replace
:window requestor
:property property
:type target
:format 8
:data-len (length value)
:data value))
;; Send a SelectionNotify event.
(setq fake-event (make-instance 'xcb:SelectionNotify
:time time
:requestor requestor
:selection selection
:target target
:property property))
(xcb:+request exwm-xim--conn
(make-instance 'xcb:SendEvent
:propagate 0
:destination requestor
:event-mask xcb:EventMask:NoEvent
:event (xcb:marshal fake-event exwm-xim--conn)))
(xcb:flush exwm-xim--conn)))))
(cl-defun exwm-xim--on-ClientMessage-0 (data _synthetic)
"Handle ClientMessage event on IMS window (new connection).
Such events would be received when clients request for _XIM_XCONNECT.
A new X connection and server window would be created to communicate with
this client."
(exwm--log)
(let ((evt (make-instance 'xcb:ClientMessage))
conn client-xwin server-xwin)
(xcb:unmarshal evt data)
(with-slots (window type data) evt
(unless (= type exwm-xim--_XIM_XCONNECT)
;; Only handle _XIM_XCONNECT.
(exwm--log "Ignore ClientMessage %s" type)
(cl-return-from exwm-xim--on-ClientMessage-0))
(setq client-xwin (elt (slot-value data 'data32) 0)
;; Create a new X connection and a new server window.
conn (xcb:connect)
server-xwin (xcb:generate-id conn))
(set-process-query-on-exit-flag (slot-value conn 'process) nil)
;; Store this client.
(plist-put exwm-xim--server-client-plist server-xwin
`[,conn ,client-xwin nil])
(plist-put exwm-xim--client-server-plist client-xwin server-xwin)
;; Select DestroyNotify events on this client window.
(xcb:+request exwm-xim--conn
(make-instance 'xcb:ChangeWindowAttributes
:window client-xwin
:value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:StructureNotify))
(xcb:flush exwm-xim--conn)
;; Handle ClientMessage events from this new connection.
(xcb:+event conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage)
;; Create a communication window.
(xcb:+request conn
(make-instance 'xcb:CreateWindow
:depth 0
:wid server-xwin
:parent exwm--root
:x 0
:y 0
:width 1
:height 1
:border-width 0
:class xcb:WindowClass:InputOutput
:visual 0
:value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
(xcb:flush conn)
;; Send connection establishment ClientMessage.
(setf window client-xwin
(slot-value data 'data32) `(,server-xwin 0 0 0 0))
(slot-makeunbound data 'data8)
(slot-makeunbound data 'data16)
(xcb:+request exwm-xim--conn
(make-instance 'xcb:SendEvent
:propagate 0
:destination client-xwin
:event-mask xcb:EventMask:NoEvent
:event (xcb:marshal evt exwm-xim--conn)))
(xcb:flush exwm-xim--conn))))
(cl-defun exwm-xim--on-ClientMessage (data _synthetic)
"Handle ClientMessage event on IMS communication window (request).
Such events would be received when clients request for _XIM_PROTOCOL.
The actual XIM request is in client message data or a property."
(exwm--log)
(let ((evt (make-instance 'xcb:ClientMessage))
conn client-xwin server-xwin)
(xcb:unmarshal evt data)
(with-slots (format window type data) evt
(unless (= type exwm-xim--_XIM_PROTOCOL)
(exwm--log "Ignore ClientMessage %s" type)
(cl-return-from exwm-xim--on-ClientMessage))
(setq server-xwin window
conn (plist-get exwm-xim--server-client-plist server-xwin)
client-xwin (elt conn 1)
conn (elt conn 0))
(cond ((= format 8)
;; Data.
(exwm-xim--on-request (vconcat (slot-value data 'data8))
conn client-xwin server-xwin))
((= format 32)
;; Atom.
(with-slots (data32) data
(with-slots (value)
(xcb:+request-unchecked+reply conn
(make-instance 'xcb:GetProperty
:delete 1
:window server-xwin
:property (elt data32 1)
:type xcb:GetPropertyType:Any
:long-offset 0
:long-length (elt data32 0)))
(when (> (length value) 0)
(exwm-xim--on-request value conn client-xwin
server-xwin)))))))))
(defun exwm-xim--on-request (data conn client-xwin server-xwin)
"Handle an XIM reuqest."
(exwm--log)
(let ((opcode (elt data 0))
;; Let-bind `xim:lsb' to make pack/unpack functions work correctly.
(xim:lsb (elt (plist-get exwm-xim--server-client-plist server-xwin) 2))
req replies)
(cond ((= opcode xim:opcode:error)
(exwm--log "ERROR: %s" data))
((= opcode xim:opcode:connect)
(exwm--log "CONNECT")
(setq xim:lsb (= (elt data 4) xim:connect-byte-order:lsb-first))
;; Store byte-order.
(setf (elt (plist-get exwm-xim--server-client-plist server-xwin) 2)
xim:lsb)
(setq req (make-instance 'xim:connect))
(xcb:unmarshal req data)
(if (and (= (slot-value req 'major-version) 1)
(= (slot-value req 'minor-version) 0)
;; Do not support authentication.
(= (slot-value req 'number) 0))
;; Accept the connection.
(push (make-instance 'xim:connect-reply) replies)
;; Deny it.
(push exwm-xim--default-error replies)))
((memq opcode (list xim:opcode:auth-required
xim:opcode:auth-reply
xim:opcode:auth-next
xim:opcode:auth-ng))
(exwm--log "AUTH: %d" opcode)
;; Deny any attempt to make authentication.
(push exwm-xim--default-error replies))
((= opcode xim:opcode:disconnect)
(exwm--log "DISCONNECT")
;; Gracefully disconnect from the client.
(exwm-xim--make-request (make-instance 'xim:disconnect-reply)
conn client-xwin)
;; Destroy the communication window & connection.
(xcb:+request conn
(make-instance 'xcb:DestroyWindow
:window server-xwin))
(xcb:disconnect conn)
;; Clean up cache.
(cl-remf exwm-xim--server-client-plist server-xwin)
(cl-remf exwm-xim--client-server-plist client-xwin))
((= opcode xim:opcode:open)
(exwm--log "OPEN")
;; Note: We make no check here.
(setq exwm-xim--im-id (if (< exwm-xim--im-id #xffff)
(1+ exwm-xim--im-id)
1))
(setq replies
(list
(make-instance 'xim:open-reply
:im-id exwm-xim--im-id
:im-attrs-length nil
:im-attrs exwm-xim--default-im-attrs
:ic-attrs-length nil
:ic-attrs exwm-xim--default-ic-attrs)
(make-instance 'xim:set-event-mask
:im-id exwm-xim--im-id
:ic-id 0
;; Static event flow.
:forward-event-mask xcb:EventMask:KeyPress
;; on-demand-synchronous method.
:synchronous-event-mask
xcb:EventMask:NoEvent))))
((= opcode xim:opcode:close)
(exwm--log "CLOSE")
(setq req (make-instance 'xim:close))
(xcb:unmarshal req data)
(push (make-instance 'xim:close-reply
:im-id (slot-value req 'im-id))
replies))
((= opcode xim:opcode:trigger-notify)
(exwm--log "TRIGGER-NOTIFY")
;; Only static event flow modal is supported.
(push exwm-xim--default-error replies))
((= opcode xim:opcode:encoding-negotiation)
(exwm--log "ENCODING-NEGOTIATION")
(setq req (make-instance 'xim:encoding-negotiation))
(xcb:unmarshal req data)
(let ((index (cl-position "COMPOUND_TEXT"
(mapcar (lambda (i) (slot-value i 'name))
(slot-value req 'names))
:test #'equal)))
(unless index
;; Fallback to portable character encoding (a subset of ASCII).
(setq index -1))
(push (make-instance 'xim:encoding-negotiation-reply
:im-id (slot-value req 'im-id)
:category
xim:encoding-negotiation-reply-category:name
:index index)
replies)))
((= opcode xim:opcode:query-extension)
(exwm--log "QUERY-EXTENSION")
(setq req (make-instance 'xim:query-extension))
(xcb:unmarshal req data)
(push (make-instance 'xim:query-extension-reply
:im-id (slot-value req 'im-id)
;; No extension support.
:length 0
:extensions nil)
replies))
((= opcode xim:opcode:set-im-values)
(exwm--log "SET-IM-VALUES")
;; There's only one possible input method attribute.
(setq req (make-instance 'xim:set-im-values))
(xcb:unmarshal req data)
(push (make-instance 'xim:set-im-values-reply
:im-id (slot-value req 'im-id))
replies))
((= opcode xim:opcode:get-im-values)
(exwm--log "GET-IM-VALUES")
(setq req (make-instance 'xim:get-im-values))
(let (im-attributes-id)
(xcb:unmarshal req data)
(setq im-attributes-id (slot-value req 'im-attributes-id))
(if (cl-notevery (lambda (i) (= i 0)) im-attributes-id)
;; Only support one IM attributes.
(push (make-instance 'xim:error
:im-id (slot-value req 'im-id)
:ic-id 0
:flag xim:error-flag:invalid-ic-id
:error-code xim:error-code:bad-something
:length 0
:type 0
:detail nil)
replies)
(push
(make-instance 'xim:get-im-values-reply
:im-id (slot-value req 'im-id)
:length nil
:im-attributes exwm-xim--default-attributes)
replies))))
((= opcode xim:opcode:create-ic)
(exwm--log "CREATE-IC")
(setq req (make-instance 'xim:create-ic))
(xcb:unmarshal req data)
;; Note: The ic-attributes slot is ignored.
(setq exwm-xim--ic-id (if (< exwm-xim--ic-id #xffff)
(1+ exwm-xim--ic-id)
1))
(push (make-instance 'xim:create-ic-reply
:im-id (slot-value req 'im-id)
:ic-id exwm-xim--ic-id)
replies))
((= opcode xim:opcode:destroy-ic)
(exwm--log "DESTROY-IC")
(setq req (make-instance 'xim:destroy-ic))
(xcb:unmarshal req data)
(push (make-instance 'xim:destroy-ic-reply
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id))
replies))
((= opcode xim:opcode:set-ic-values)
(exwm--log "SET-IC-VALUES")
(setq req (make-instance 'xim:set-ic-values))
(xcb:unmarshal req data)
;; We don't distinguish between input contexts.
(push (make-instance 'xim:set-ic-values-reply
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id))
replies))
((= opcode xim:opcode:get-ic-values)
(exwm--log "GET-IC-VALUES")
(setq req (make-instance 'xim:get-ic-values))
(xcb:unmarshal req data)
(push (make-instance 'xim:get-ic-values-reply
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id)
:length nil
:ic-attributes exwm-xim--default-attributes)
replies))
((= opcode xim:opcode:set-ic-focus)
(exwm--log "SET-IC-FOCUS")
;; All input contexts are the same.
)
((= opcode xim:opcode:unset-ic-focus)
(exwm--log "UNSET-IC-FOCUS")
;; All input contexts are the same.
)
((= opcode xim:opcode:forward-event)
(exwm--log "FORWARD-EVENT")
(setq req (make-instance 'xim:forward-event))
(xcb:unmarshal req data)
(exwm-xim--handle-forward-event-request req xim:lsb conn
client-xwin))
((= opcode xim:opcode:sync)
(exwm--log "SYNC")
(setq req (make-instance 'xim:sync))
(xcb:unmarshal req data)
(push (make-instance 'xim:sync-reply
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id))
replies))
((= opcode xim:opcode:sync-reply)
(exwm--log "SYNC-REPLY"))
((= opcode xim:opcode:reset-ic)
(exwm--log "RESET-IC")
;; No context-specific data saved.
(setq req (make-instance 'xim:reset-ic))
(xcb:unmarshal req data)
(push (make-instance 'xim:reset-ic-reply
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id)
:length 0
:string "")
replies))
((memq opcode (list xim:opcode:str-conversion-reply
xim:opcode:preedit-start-reply
xim:opcode:preedit-caret-reply))
(exwm--log "PREEDIT: %d" opcode)
;; No preedit support.
(push exwm-xim--default-error replies))
(t
(exwm--log "Bad protocol")
(push exwm-xim--default-error replies)))
;; Actually send the replies.
(when replies
(mapc (lambda (reply)
(exwm-xim--make-request reply conn client-xwin))
replies)
(xcb:flush conn))))
(defun exwm-xim--handle-forward-event-request (req lsb conn client-xwin)
(let ((im-func (with-current-buffer (window-buffer)
input-method-function))
key-event keysym keysyms event result)
;; Note: The flag slot is ignored.
;; Do conversion in client's byte-order.
(let ((xcb:lsb lsb))
(setq key-event (make-instance 'xcb:KeyPress))
(xcb:unmarshal key-event (slot-value req 'event)))
(with-slots (detail state) key-event
(setq keysym (xcb:keysyms:keycode->keysym exwm-xim--conn detail
state))
(when (/= (car keysym) 0)
(setq event (xcb:keysyms:keysym->event
exwm-xim--conn
(car keysym)
(logand state (lognot (cdr keysym)))))))
(while (or (slot-value req 'event) unread-command-events)
(unless (slot-value req 'event)
(setq event (pop unread-command-events))
;; Handle events in (t . EVENT) format.
(when (and (consp event)
(eq (car event) t))
(setq event (cdr event))))
(if (or (not im-func)
;; `list' is the default method.
(eq im-func #'list)
(not event)
;; Select only printable keys.
(not (integerp event)) (> #x20 event) (< #x7e event))
;; Either there is no active input method, or invalid key
;; is detected.
(with-slots ((raw-event event)
im-id ic-id serial-number)
req
(if raw-event
(setq event raw-event)
(setq keysyms (xcb:keysyms:event->keysyms exwm-xim--conn event))
(with-slots (detail state) key-event
(setf detail (xcb:keysyms:keysym->keycode exwm-xim--conn
(caar keysyms))
state (cdar keysyms)))
(setq event (let ((xcb:lsb lsb))
(xcb:marshal key-event conn))))
(when event
(exwm-xim--make-request
(make-instance 'xim:forward-event
:im-id im-id
:ic-id ic-id
:flag xim:commit-flag:synchronous
:serial-number serial-number
:event event)
conn client-xwin)))
(when (eq exwm--selected-input-mode 'char-mode)
;; Grab keyboard temporarily for char-mode.
(exwm-input--grab-keyboard))
(unwind-protect
(with-temp-buffer
;; This variable is used to test whether exwm-xim is enabled.
;; Used by e.g. pyim-probe.
(setq-local exwm-xim-buffer-p t)
;; Always show key strokes.
(let ((input-method-use-echo-area t)
(exwm-input-line-mode-passthrough t))
(setq result (funcall im-func event))
;; Clear echo area for the input method.
(message nil)
;; This also works for portable character encoding.
(setq result
(encode-coding-string (concat result)
'compound-text-with-extensions))
(exwm-xim--make-request
(make-instance 'xim:commit-x-lookup-chars
:im-id (slot-value req 'im-id)
:ic-id (slot-value req 'ic-id)
:flag (logior xim:commit-flag:synchronous
xim:commit-flag:x-lookup-chars)
:length (length result)
:string result)
conn client-xwin)))
(when (eq exwm--selected-input-mode 'char-mode)
(exwm-input--release-keyboard))))
(xcb:flush conn)
(setf event nil
(slot-value req 'event) nil))))
(defun exwm-xim--make-request (req conn client-xwin)
"Make an XIM request REQ via connection CONN.
CLIENT-XWIN would receive a ClientMessage event either telling the client
the request data or where to fetch the data."
(exwm--log)
(let ((data (xcb:marshal req))
property format client-message-data client-message)
(if (<= (length data) 20)
;; Send short requests directly with client messages.
(setq format 8
;; Pad to 20 bytes.
data (append data (make-list (- 20 (length data)) 0))
client-message-data (make-instance 'xcb:ClientMessageData
:data8 data))
;; Send long requests with properties.
(setq property (exwm--intern-atom (format "_EXWM_XIM_%x"
exwm-xim--property-index)))
(cl-incf exwm-xim--property-index)
(xcb:+request conn
(make-instance 'xcb:ChangeProperty
:mode xcb:PropMode:Append
:window client-xwin
:property property
:type xcb:Atom:STRING
:format 8
:data-len (length data)
:data data))
;; Also send a client message to notify the client about this property.
(setq format 32
client-message-data (make-instance 'xcb:ClientMessageData
:data32 `(,(length data)
,property
;; Pad to 20 bytes.
0 0 0))))
;; Send the client message.
(setq client-message (make-instance 'xcb:ClientMessage
:format format
:window client-xwin
:type exwm-xim--_XIM_PROTOCOL
:data client-message-data))
(xcb:+request conn
(make-instance 'xcb:SendEvent
:propagate 0
:destination client-xwin
:event-mask xcb:EventMask:NoEvent
:event (xcb:marshal client-message conn)))))
(defun exwm-xim--on-DestroyNotify (data synthetic)
"Do cleanups on receiving DestroyNotify event.
Such event would be received when the client window is destroyed."
(exwm--log)
(unless synthetic
(let ((evt (make-instance 'xcb:DestroyNotify))
conn client-xwin server-xwin)
(xcb:unmarshal evt data)
(setq client-xwin (slot-value evt 'window)
server-xwin (plist-get exwm-xim--client-server-plist client-xwin))
(when server-xwin
(setq conn (aref (plist-get exwm-xim--server-client-plist server-xwin)
0))
(cl-remf exwm-xim--server-client-plist server-xwin)
(cl-remf exwm-xim--client-server-plist client-xwin)
;; Destroy the communication window & connection.
(xcb:+request conn
(make-instance 'xcb:DestroyWindow
:window server-xwin))
(xcb:disconnect conn)))))
(cl-defun exwm-xim--init ()
"Initialize the XIM module."
(exwm--log)
(when exwm-xim--conn
(cl-return-from exwm-xim--init))
;; Initialize atoms.
(setq exwm-xim--@server (exwm--intern-atom "@server=exwm-xim")
exwm-xim--LOCALES (exwm--intern-atom "LOCALES")
exwm-xim--TRANSPORT (exwm--intern-atom "TRANSPORT")
exwm-xim--XIM_SERVERS (exwm--intern-atom "XIM_SERVERS")
exwm-xim--_XIM_PROTOCOL (exwm--intern-atom "_XIM_PROTOCOL")
exwm-xim--_XIM_XCONNECT (exwm--intern-atom "_XIM_XCONNECT"))
;; Create a new connection and event window.
(setq exwm-xim--conn (xcb:connect)
exwm-xim--event-xwin (xcb:generate-id exwm-xim--conn))
(set-process-query-on-exit-flag (slot-value exwm-xim--conn 'process) nil)
;; Initialize xcb:keysyms module.
(xcb:keysyms:init exwm-xim--conn)
;; Listen to SelectionRequest event for connection establishment.
(xcb:+event exwm-xim--conn 'xcb:SelectionRequest
#'exwm-xim--on-SelectionRequest)
;; Listen to ClientMessage event on IMS window for new XIM connection.
(xcb:+event exwm-xim--conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage-0)
;; Listen to DestroyNotify event to do cleanups.
(xcb:+event exwm-xim--conn 'xcb:DestroyNotify #'exwm-xim--on-DestroyNotify)
;; Create the event window.
(xcb:+request exwm-xim--conn
(make-instance 'xcb:CreateWindow
:depth 0
:wid exwm-xim--event-xwin
:parent exwm--root
:x 0
:y 0
:width 1
:height 1
:border-width 0
:class xcb:WindowClass:InputOutput
:visual 0
:value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
;; Set the selection owner.
(xcb:+request exwm-xim--conn
(make-instance 'xcb:SetSelectionOwner
:owner exwm-xim--event-xwin
:selection exwm-xim--@server
:time xcb:Time:CurrentTime))
;; Set XIM_SERVERS property on the root window.
(xcb:+request exwm-xim--conn
(make-instance 'xcb:ChangeProperty
:mode xcb:PropMode:Prepend
:window exwm--root
:property exwm-xim--XIM_SERVERS
:type xcb:Atom:ATOM
:format 32
:data-len 1
:data (funcall (if xcb:lsb
#'xcb:-pack-u4-lsb
#'xcb:-pack-u4)
exwm-xim--@server)))
(xcb:flush exwm-xim--conn))
(cl-defun exwm-xim--exit ()
"Exit the XIM module."
(exwm--log)
;; Close IMS communication connections.
(mapc (lambda (i)
(when (vectorp i)
(when (slot-value (elt i 0) 'connected)
(xcb:disconnect (elt i 0)))))
exwm-xim--server-client-plist)
;; Close the IMS connection.
(unless (and exwm-xim--conn
(slot-value exwm-xim--conn 'connected))
(cl-return-from exwm-xim--exit))
;; Remove exwm-xim from XIM_SERVERS.
(let ((reply (xcb:+request-unchecked+reply exwm-xim--conn
(make-instance 'xcb:GetProperty
:delete 1
:window exwm--root
:property exwm-xim--XIM_SERVERS
:type xcb:Atom:ATOM
:long-offset 0
:long-length 1000)))
unpacked-reply pack unpack)
(unless reply
(cl-return-from exwm-xim--exit))
(setq reply (slot-value reply 'value))
(unless (> (length reply) 4)
(cl-return-from exwm-xim--exit))
(setq reply (vconcat reply)
pack (if xcb:lsb #'xcb:-pack-u4-lsb #'xcb:-pack-u4)
unpack (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4))
(dotimes (i (/ (length reply) 4))
(push (funcall unpack reply (* i 4)) unpacked-reply))
(setq unpacked-reply (delq exwm-xim--@server unpacked-reply)
reply (mapcar pack unpacked-reply))
(xcb:+request exwm-xim--conn
(make-instance 'xcb:ChangeProperty
:mode xcb:PropMode:Replace
:window exwm--root
:property exwm-xim--XIM_SERVERS
:type xcb:Atom:ATOM
:format 32
:data-len (length reply)
:data reply))
(xcb:flush exwm-xim--conn))
(xcb:disconnect exwm-xim--conn)
(setq exwm-xim--conn nil))
(defun exwm-xim-enable ()
"Enable XIM support for EXWM."
(exwm--log)
(add-hook 'exwm-init-hook #'exwm-xim--init)
(add-hook 'exwm-exit-hook #'exwm-xim--exit))
(provide 'exwm-xim)
;;; exwm-xim.el ends here

1109
exwm.el
View file

File diff suppressed because it is too large Load diff

20
xinitrc
View file

@ -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