Compare commits
172 Commits
a3791c4048
...
main
Author | SHA1 | Date | |
---|---|---|---|
72c9dc87a5
|
|||
2d85457f5d
|
|||
a23464a17a
|
|||
b7dd3010a0
|
|||
73530f887f
|
|||
19d559d626
|
|||
5bb3c77e3c
|
|||
b036ee2a32
|
|||
00bdf1e8eb
|
|||
8112f6b1dc
|
|||
e0c8453dfe
|
|||
78ad4f0ba6
|
|||
95fe0861c9
|
|||
b723dc961c
|
|||
3883a90da3
|
|||
b374fc57e2
|
|||
89e010474f
|
|||
226ea54105
|
|||
819d0eda4f
|
|||
997be323f5
|
|||
2d072241a7
|
|||
0fd70fb03c
|
|||
90fbbda854
|
|||
a5e3bd4c11
|
|||
2a2264be9f
|
|||
dabf480e7d
|
|||
b1d77b0f5d
|
|||
6ea87de1b5
|
|||
386e65c0f4
|
|||
e158df3fd1
|
|||
816e696f47
|
|||
e2db4e1193
|
|||
3ebc12ddc9
|
|||
173178313e
|
|||
2313ad1b25
|
|||
a3c1ccb6c7
|
|||
de206d7b93
|
|||
3f23480cb9
|
|||
d65948ca41
|
|||
655eb827e1
|
|||
87ec1690ee
|
|||
a6a712ea99
|
|||
427b70f347
|
|||
641aa325dc
|
|||
4282129190
|
|||
58b6608cbb
|
|||
91a54013b9
|
|||
9c413aaa38
|
|||
c8ba0ce0ca
|
|||
9a6a9fcbf8
|
|||
fd942c275f
|
|||
6a1d358548
|
|||
719a2ffac7
|
|||
2af97af4dd
|
|||
9611655fa0
|
|||
44c3cde2c5
|
|||
5a3735644d
|
|||
b33937f50b
|
|||
4dfd389998
|
|||
7b03b977ac
|
|||
21d861dbd0
|
|||
9a9a707a10
|
|||
14467fb9f8
|
|||
96c175e0bb
|
|||
966c3392aa
|
|||
7ef055bc51
|
|||
6d3b19fe46
|
|||
bebd49f14a
|
|||
af17d6e0dc
|
|||
c49caf7a25
|
|||
54e58aca7e
|
|||
0d1d4e10c1
|
|||
02122f979b
|
|||
83d40e3713
|
|||
100fe208e2
|
|||
101342c5e3
|
|||
459705d05a
|
|||
ed237a2e03
|
|||
82e2f5d753
|
|||
e1b18eeefe
|
|||
80a0d4aefe
|
|||
b307a21e11
|
|||
96b64a144e
|
|||
dc789627c0
|
|||
09914fc3a9
|
|||
c2001ae2b3
|
|||
b6ddcd03c0
|
|||
f81f0c6a15
|
|||
39efc3d5ba
|
|||
b794eebeb7
|
|||
6cdd4f6aa3
|
|||
190627d982
|
|||
b148423914
|
|||
5c3c492fd8
|
|||
535dc0313e
|
|||
8d7aba02d3
|
|||
19e2d6fd59
|
|||
f6b37f1b10
|
|||
32b3042418
|
|||
4e94728235
|
|||
bf1f2a7bfa
|
|||
e7392c6c09
|
|||
a0249716b6
|
|||
f9f7badd76
|
|||
2cd476d2b1
|
|||
738cd67f00
|
|||
222fcacfeb
|
|||
04fa288627
|
|||
998d5cf3fa
|
|||
ac07328aca
|
|||
2ef42f86dc
|
|||
4dc28f50d7
|
|||
71fb77f758
|
|||
5d09db86a0
|
|||
a5e9144d63
|
|||
6708db3bdc
|
|||
4fc82fb461
|
|||
91594d0e52
|
|||
980408f6cc
|
|||
ab96feb519
|
|||
d4d5da7c62
|
|||
0769a67281
|
|||
f4a675c225
|
|||
6ce7d9aaed
|
|||
d77e600000
|
|||
22c70eaaa6
|
|||
888a8158d9
|
|||
e9e4e89930
|
|||
b54abacff3
|
|||
003bc783d7
|
|||
a0e268b1a9
|
|||
34e599de92
|
|||
68aa9afd18
|
|||
48d546c561
|
|||
f55065d312
|
|||
4f53be9f33
|
|||
97bc04e3ad
|
|||
b1f3a1a9f4
|
|||
a0a1738ff6
|
|||
a83f5ea6c1
|
|||
7cd012f02b
|
|||
cc91d6b7b7
|
|||
566d338a9a
|
|||
267f209037
|
|||
9ae0d7a93f
|
|||
a6ba5e74a3
|
|||
2c08ad6436
|
|||
7d01b9791f
|
|||
e79ade8554
|
|||
046ba351ce
|
|||
93ed2b9e39
|
|||
cf50a7c5b7
|
|||
a5672f9284
|
|||
ea8d6bfe57
|
|||
e985a615b4
|
|||
5e54de5f92
|
|||
7c2cb2f54d
|
|||
e7b13a1350
|
|||
49c373d58b
|
|||
69e77a7449
|
|||
269a3fa9d9
|
|||
7ebb1e095e
|
|||
abb4ce7925
|
|||
a33e41de3d
|
|||
7b96dad1f8
|
|||
af9fc9efdf
|
|||
06ec526b97
|
|||
3c033515ad
|
|||
389b3d1891
|
|||
85242cd785
|
|||
718b24d5e9
|
|||
1e13252624
|
2
.gitignore
vendored
2
.gitignore
vendored
@ -5,3 +5,5 @@
|
||||
/tree-sitter/
|
||||
/tramp
|
||||
/dape-breakpoints
|
||||
flycheck_init.el
|
||||
local-init.el*
|
||||
|
674
LICENSE
Normal file
674
LICENSE
Normal file
@ -0,0 +1,674 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program does terminal interaction, make it output a short
|
||||
notice like this when it starts in an interactive mode:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, your program's commands
|
||||
might be different; for a GUI interface, you would use an "about box".
|
||||
|
||||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<https://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
|
||||
<https://www.gnu.org/licenses/why-not-lgpl.html>.
|
9
README.md
Normal file
9
README.md
Normal file
@ -0,0 +1,9 @@
|
||||
# Emacs Config
|
||||
This is just my personal Emacs configuration. I use Emacs for mail, RSS, and, of
|
||||
course, editing text. Most of the configuration is in `init.el`. I use
|
||||
`use-package` for every package, even built-in ones. You can try searching for
|
||||
"use-package" and then the name of the package to find the line where its
|
||||
configuration start.
|
||||
|
||||
The `elisp` directory holds some extra configuration for specific things that I
|
||||
thought were too big to fit into `init.el`.
|
298
disabled.el
298
disabled.el
@ -109,72 +109,240 @@
|
||||
;; "Hook to do stuff in llama buffers."
|
||||
;; (auto-fill-mode -1)))
|
||||
|
||||
;; sly
|
||||
;; (use-package sly
|
||||
;; :hook (lisp-mode . my/-lisp-mode-autoconnect-sly)
|
||||
;; :bind (:map sly-mode-map
|
||||
;; ("C-c e" . my/sly-show-notes-at-point))
|
||||
;; :autoload sly-connected-p
|
||||
;; :init
|
||||
;; (defun my/-lisp-mode-autoconnect-sly ()
|
||||
;; (unless (sly-connected-p)
|
||||
;; (sly)))
|
||||
;; (defun my/sly-notes-at-point (pos &optional buffer)
|
||||
;; "Returns the sly notes at POS in BUFFER.
|
||||
;; If BUFFER is nil, the current buffer is used."
|
||||
;; (with-current-buffer (or buffer (current-buffer))
|
||||
;; (cl-loop for overlay in (overlays-at pos)
|
||||
;; for note = (overlay-get overlay 'sly-note)
|
||||
;; when note
|
||||
;; collect note)))
|
||||
;; (defun my/sly-show-notes-at-point ()
|
||||
;; "Show all sly notes at point in a floating window."
|
||||
;; (interactive)
|
||||
;; (my/floating-tooltip " *sly-note-posframe*"
|
||||
;; (with-output-to-string
|
||||
;; (dolist (note (my/sly-notes-at-point (point)))
|
||||
;; (when-let (msg (plist-get note :message))
|
||||
;; (princ "·")
|
||||
;; (princ msg)
|
||||
;; (terpri))))))
|
||||
;; (setq inferior-lisp-program "/usr/bin/sbcl")
|
||||
;; company (in buffer auto-complete)
|
||||
;; (use-package company
|
||||
;; :defer nil
|
||||
;; :bind (("M-TAB" . company-complete)
|
||||
;; ("M-<tab>" . company-complete)
|
||||
;; ("C-c f" . company-files)
|
||||
;; ([remap dabbrev-expand] . company-dabbrev)
|
||||
;; :map prog-mode-map
|
||||
;; ([remap company-dabbrev] . company-dabbrev-code))
|
||||
;; :hook ((company-search-mode . my/-company-search-mode-add-lighter)
|
||||
;; (sh-mode . my/-company-setup-shell-mode))
|
||||
;; :config
|
||||
;; (sly-symbol-completion-mode -1))
|
||||
|
||||
;; corfu (autocomplete)
|
||||
;; (use-package corfu
|
||||
;; :bind (("M-<tab>" . completion-at-point)
|
||||
;; :map corfu-map
|
||||
;; ("M-SPC" . corfu-insert-separator)
|
||||
;; ("M-m" . my/corfu-move-to-minibuffer))
|
||||
;; :init
|
||||
;; (defun my/corfu-move-to-minibuffer ()
|
||||
;; (interactive)
|
||||
;; (when completion-in-region--data
|
||||
;; (let ((completion-extra-properties corfu--extra)
|
||||
;; completion-cycle-threshold completion-cycling)
|
||||
;; (apply #'consult-completion-in-region completion-in-region--data))))
|
||||
;; (setq corfu-cycle t
|
||||
;; corfu-auto t
|
||||
;; corfu-on-exact-match nil
|
||||
;; completion-cycle-threshold nil)
|
||||
;; (global-corfu-mode 1)
|
||||
;; (corfu-popupinfo-mode 1)
|
||||
;; (defun my/-company-setup-shell-mode ()
|
||||
;; (setq-local company-backends '(company-files company-keywords
|
||||
;; company-dabbrev-code)))
|
||||
;; (defun my/-company-search-mode-add-lighter ()
|
||||
;; (if company-search-mode
|
||||
;; (cl-pushnew company-search-lighter global-mode-string :test 'equal)
|
||||
;; (setq global-mode-string
|
||||
;; (cl-delete company-search-lighter global-mode-string :test 'equal))))
|
||||
;; (defun my/-company-set-completion-styles (oldfun &rest args)
|
||||
;; (let ((completion-styles '(basic emacs21 flex)))
|
||||
;; (apply oldfun args)))
|
||||
;; (advice-add 'company-capf :around 'my/-company-set-completion-styles)
|
||||
;; (setopt company-format-margin-function #'company-text-icons-margin
|
||||
;; company-require-match nil
|
||||
;; company-tooltip-align-annotations t)
|
||||
;; (setq company-transformers '(company-sort-by-occurrence))
|
||||
;; (global-company-mode 1))
|
||||
;; (use-package company-quickhelp
|
||||
;; :bind (:map company-active-map
|
||||
;; ("M-h" . company-quickhelp-manual-begin))
|
||||
;; :after company
|
||||
;; :config
|
||||
;; (add-to-list 'corfu-continue-commands #'my/corfu-move-to-minibuffer))
|
||||
;; (use-package corfu-terminal
|
||||
;; :init
|
||||
;; (corfu-terminal-mode 1))
|
||||
;; (company-quickhelp-mode 1)
|
||||
;; (setopt company-quickhelp-delay nil))
|
||||
|
||||
;; ;; cape (a bunch of capfs!)
|
||||
;; (use-package cape
|
||||
;; :bind (("C-c p" . cape-dabbrev)
|
||||
;; ([remap dabbrev-expand] . cape-dabbrev)
|
||||
;; ("C-c P" . cape-line)
|
||||
;; ("C-c f" . cape-file))
|
||||
;; :hook (text-mode . my/-cape-setup-text-mode)
|
||||
;; (La)TeX
|
||||
;; (use-package tex-mode
|
||||
;; :hook ((latex-mode . eglot-ensure)
|
||||
;; (tex-mode . my/-setup-tex-mode-compile-command))
|
||||
;; :init
|
||||
;; (defun my/-cape-setup-text-mode ()
|
||||
;; (setq-local completion-at-point-functions
|
||||
;; '(cape-dict cape-dabbrev)
|
||||
;; corfu-auto nil)))
|
||||
;; (defun my/-setup-tex-mode-compile-command ()
|
||||
;; "Setup `compile-command' for `tex-mode'."
|
||||
;; (let ((quoted-name (shell-quote-argument buffer-file-name)))
|
||||
;; (setq-local compile-command
|
||||
;; (concat "latexmk -pdf "
|
||||
;; "-auxdir=" quoted-name "-build"
|
||||
;; " " quoted-name))))
|
||||
;; :config
|
||||
;; (add-to-list 'auto-mode-alist '("/\\.latexmkrc\\'" . perl-mode)))
|
||||
|
||||
;; flyspell
|
||||
;; (use-package flyspell
|
||||
;; :hook
|
||||
;; (((text-mode message-mode tex-mode) . flyspell-mode)
|
||||
;; (prog-mode . flyspell-prog-mode))
|
||||
;; :config
|
||||
;; (setq ispell-program-name "hunspell"
|
||||
;; flyspell-issue-message-flag nil
|
||||
;; flyspell-issue-welcome-flag nil)
|
||||
;; (define-key flyspell-mode-map (kbd "C-;") nil t)
|
||||
;; (define-key flyspell-mode-map (kbd "C-,") nil t))
|
||||
|
||||
;; (use-package aggressive-indent
|
||||
;; :hook (prog-mode . aggressive-indent-mode)
|
||||
;; :config
|
||||
;; (add-to-list 'aggressive-indent-protected-commands
|
||||
;; #'evil-undo))
|
||||
|
||||
;; ;; easier identification of local variables
|
||||
;; (use-package color-identifiers-mode
|
||||
;; :hook (prog-mode . color-identifiers-mode-maybe)
|
||||
;; :init
|
||||
;; (setq color-identifiers:num-colors 10
|
||||
;; color-identifiers:recoloring-delay 0.5)
|
||||
;; :config
|
||||
;; ;; make sure that remapped treesitter modes are handled
|
||||
;; (defun my/color-identifiers-mode-remap-ts-modes ()
|
||||
;; (dolist (entry color-identifiers:modes-alist)
|
||||
;; (cl-destructuring-bind (mode &rest props) entry
|
||||
;; (when-let ((remapped-mode (alist-get mode major-mode-remap-alist))
|
||||
;; ((string-match-p "-ts-" (symbol-name remapped-mode)))
|
||||
;; ((not (assq remapped-mode color-identifiers:modes-alist))))
|
||||
;; ;; no need to test with `add-to-list'
|
||||
;; (push (cons remapped-mode props) color-identifiers:modes-alist)))))
|
||||
;; (my/color-identifiers-mode-remap-ts-modes)
|
||||
;; (setf (alist-get 'lisp-interaction-mode color-identifiers:modes-alist)
|
||||
;; (alist-get 'emacs-lisp-mode color-identifiers:modes-alist))
|
||||
;; (defun my/-color-identifiers-elisp-handle-let-like (sexp output)
|
||||
;; (cl-destructuring-bind (_name &optional vars &rest body) sexp
|
||||
;; (dolist (entry vars body)
|
||||
;; (cond
|
||||
;; ((and entry (symbolp entry)) (puthash entry t output))
|
||||
;; ((and (car entry) (symbolp (car entry)))
|
||||
;; (puthash (car entry) t output))))))
|
||||
;; (defun my/-color-identifiers-parse-lambda-list (list output)
|
||||
;; (dolist (entry list)
|
||||
;; (cond
|
||||
;; ((and entry (symbolp entry)
|
||||
;; (not (string-prefix-p ":" (symbol-name entry)))
|
||||
;; (not (string-prefix-p "&" (symbol-name entry))))
|
||||
;; (puthash entry t output))
|
||||
;; ((and (car-safe entry) (symbolp (car entry)))
|
||||
;; (puthash (car entry) t output)))))
|
||||
;; (defun my/-color-identifiers-elisp-handle-destructing-bind-like
|
||||
;; (sexp output)
|
||||
;; (cl-destructuring-bind (_name &optional vars &rest expr-and-body) sexp
|
||||
;; (my/-color-identifiers-parse-lambda-list vars output)
|
||||
;; expr-and-body))
|
||||
;; (defun my/-color-identifiers-elisp-handle-defun-like
|
||||
;; (sexp output)
|
||||
;; (cl-destructuring-bind (_name _func &optional vars &rest body) sexp
|
||||
;; (my/-color-identifiers-parse-lambda-list vars output)
|
||||
;; body))
|
||||
;; (defun my/-color-identifiers-elisp-handle-dolist-like
|
||||
;; (sexp output)
|
||||
;; (cl-destructuring-bind (_name &optional spec &rest body) sexp
|
||||
;; (cl-destructuring-bind (&optional var &rest forms) spec
|
||||
;; (when (symbolp var)
|
||||
;; (puthash var t output))
|
||||
;; (append body forms))))
|
||||
;; (defun my/-color-identifiers-elisp-handle-loop (sexp output)
|
||||
;; (let (body-forms)
|
||||
;; (cl-maplist
|
||||
;; (lambda (kwds)
|
||||
;; (cl-case (car kwds)
|
||||
;; (for ;; this could be a dotted list
|
||||
;; (let ((tail (ensure-list (cadr kwds))))
|
||||
;; (while tail
|
||||
;; (when (and (consp tail) (symbolp (car tail)))
|
||||
;; (puthash (car tail) t output))
|
||||
;; (when (and (consp tail) (symbolp (cdr tail)))
|
||||
;; (puthash (cdr tail) t output))
|
||||
;; (setq tail (cdr-safe tail)))))
|
||||
;; (using
|
||||
;; (when (and (listp (cdr kwds))
|
||||
;; (symbolp (cl-second (cdr kwds))))
|
||||
;; (puthash (cl-second (cdr kwds)) t output)))
|
||||
;; ((with into)
|
||||
;; (when (symbolp (cadr kwds))
|
||||
;; (puthash (cadr kwds) t output)))
|
||||
;; (t
|
||||
;; (unless (atom (car kwds))
|
||||
;; (push (car kwds) body-forms)))))
|
||||
;; (cdr sexp))
|
||||
;; body-forms))
|
||||
;; (defun my/-color-identifiers-elisp-handle-do-like (sexp output)
|
||||
;; (let ((eval-forms))
|
||||
;; (cl-destructuring-bind (name &optional vars test-forms &rest body) sexp
|
||||
;; (dolist (entry vars (append eval-forms test-forms body))
|
||||
;; (cl-destructuring-bind (&optional var init step &rest _)
|
||||
;; entry
|
||||
;; (when (symbolp var)
|
||||
;; (puthash var t output)
|
||||
;; (cl-callf nconc eval-forms (list init step))))))))
|
||||
;; (defvar my/-color-identifiers-eslip-handlers
|
||||
;; (let ((table (make-hash-table)))
|
||||
;; (puthash 'quote #'ignore table)
|
||||
;; (puthash 'function #'ignore table)
|
||||
;; (puthash 'let #'my/-color-identifiers-elisp-handle-let-like table)
|
||||
;; (puthash 'let* #'my/-color-identifiers-elisp-handle-let-like table)
|
||||
;; (puthash 'cl-destructuring-bind
|
||||
;; #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
|
||||
;; (puthash 'with-slots
|
||||
;; #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
|
||||
;; (puthash 'lambda
|
||||
;; #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
|
||||
;; (puthash 'cl-function
|
||||
;; #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
|
||||
;; (puthash 'defun
|
||||
;; #'my/-color-identifiers-elisp-handle-defun-like table)
|
||||
;; (puthash 'cl-defun
|
||||
;; #'my/-color-identifiers-elisp-handle-defun-like table)
|
||||
;; (puthash 'defmacro
|
||||
;; #'my/-color-identifiers-elisp-handle-defun-like table)
|
||||
;; (puthash 'cl-defmacro
|
||||
;; #'my/-color-identifiers-elisp-handle-defun-like table)
|
||||
;; (puthash 'cl-defmacro
|
||||
;; #'my/-color-identifiers-elisp-handle-defun-like table)
|
||||
;; (puthash 'cl-loop
|
||||
;; #'my/-color-identifiers-elisp-handle-loop table)
|
||||
;; (puthash 'dolist
|
||||
;; #'my/-color-identifiers-elisp-handle-dolist-like table)
|
||||
;; (puthash 'dotimes
|
||||
;; #'my/-color-identifiers-elisp-handle-dolist-like table)
|
||||
;; (puthash 'cl-dolist
|
||||
;; #'my/-color-identifiers-elisp-handle-dolist-like table)
|
||||
;; (puthash 'cl-dotimes
|
||||
;; #'my/-color-identifiers-elisp-handle-dolist-like table)
|
||||
;; (puthash 'cl-do
|
||||
;; #'my/-color-identifiers-elisp-handle-do-like table)
|
||||
;; table)
|
||||
;; "A list of functions that find declarations in variables.
|
||||
;; This is used in `my/-color-identifiers-elisp-declarations-in-sexp'. It is a
|
||||
;; hash table of function (or macro) names and a function that handles them. The
|
||||
;; functions should be of two arguments. The first is the sexp to parse. The
|
||||
;; second is a hash table with the keys being the symbols of local variables. The
|
||||
;; function should return a list of the forms that it contains that should be
|
||||
;; recursively searched.")
|
||||
;; (defun my/-color-identifiers-lisp-declarations-in-sexp (sexp output table)
|
||||
;; "Get all of the variable declarations in SEXP and place them in OUTPUT.
|
||||
;; OUTPUT is a hash table. TABLE is a table like
|
||||
;; `my/-color-identifiers-elisp-declarations-in-sexp'."
|
||||
;; (let ((stack (list sexp)))
|
||||
;; (while (and stack (not (input-pending-p)))
|
||||
;; (let ((entry (pop stack)))
|
||||
;; (when (proper-list-p entry)
|
||||
;; (if-let ((handler (gethash (car entry) table)))
|
||||
;; (cl-callf nconc stack
|
||||
;; (copy-sequence (funcall handler entry output)))
|
||||
;; (cl-callf nconc stack
|
||||
;; (copy-sequence (cdr entry)))))))))
|
||||
;; (defun my/-color-identifiers-lisp-declarations-in-buffer (&optional buffer)
|
||||
;; (let ((result (make-hash-table)))
|
||||
;; (save-excursion
|
||||
;; (goto-char (point-min))
|
||||
;; (condition-case nil
|
||||
;; (while t
|
||||
;; (condition-case nil
|
||||
;; (let ((sexp (read (or buffer (current-buffer)))))
|
||||
;; (my/-color-identifiers-lisp-declarations-in-sexp
|
||||
;; sexp result my/-color-identifiers-eslip-handlers))
|
||||
;; (invalid-read-syntax nil)))
|
||||
;; (end-of-file nil))
|
||||
;; (let ((names))
|
||||
;; (maphash (lambda (k _v)
|
||||
;; (unless (or (eq k t) (not k) (boundp k))
|
||||
;; (push (symbol-name k) names)))
|
||||
;; result)
|
||||
;; names))))
|
||||
;; (color-identifiers:set-declaration-scan-fn
|
||||
;; 'emacs-lisp-mode
|
||||
;; 'my/-color-identifiers-lisp-declarations-in-buffer)
|
||||
;; (color-identifiers:set-declaration-scan-fn
|
||||
;; 'lisp-interaction-mode
|
||||
;; 'my/-color-identifiers-lisp-declarations-in-buffer))
|
||||
|
311
elisp/corfu-terminal-popupinfo.el
Normal file
311
elisp/corfu-terminal-popupinfo.el
Normal file
@ -0,0 +1,311 @@
|
||||
;;; corfu-terminal-popupinfo.el --- corfu-popupinfo support in the terminal -*- lexical-binding: t -*-
|
||||
|
||||
;;; Commentary:
|
||||
;; To make use of this file, simply `require' it, and then enable
|
||||
;; `corfu-terminal-popupinfo-mode', which is a global mode. Note that
|
||||
;; `corfu-terminal-mode' MUST be loaded and enabled for this to work.
|
||||
|
||||
;;; Code:
|
||||
(require 'popon)
|
||||
(require 'corfu-terminal)
|
||||
(require 'corfu-popupinfo)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar ctp--popon nil
|
||||
"The current popon, or nil if there is none.")
|
||||
|
||||
(defvar ctp--buffer nil
|
||||
"The buffer holding the current candidate's documentation.")
|
||||
|
||||
(defun ctp--get-buffer ()
|
||||
"Create or return `ctp--buffer'."
|
||||
(unless (and (bufferp ctp--buffer) (buffer-live-p ctp--buffer))
|
||||
(setq ctp--buffer (generate-new-buffer " *corfu-terminal-popupinfo*" t)))
|
||||
ctp--buffer)
|
||||
|
||||
(defun ctp--visible-p ()
|
||||
"Return non-nil if the terminal popup window is visible."
|
||||
(popon-live-p ctp--popon))
|
||||
|
||||
(defun ctp--corfu-popupinfo--visible-p-advice (oldfun &optional frame)
|
||||
"Advice for `corfu-popupinfo--visible-p'.
|
||||
If FRAME is nil, this will return `ctp--visible-p'. If
|
||||
FRAME is `corfu--frame', this will return weather the `corfu-terminal--popon' is
|
||||
live or not.
|
||||
|
||||
As this is :around advice, OLDFUN is the real (advised) function to call."
|
||||
(cond
|
||||
((and (not frame) (ctp--visible-p)))
|
||||
((and (eq frame corfu--frame) (popon-live-p corfu-terminal--popon)))
|
||||
((funcall oldfun frame))))
|
||||
|
||||
(defun ctp--close ()
|
||||
"Close the popon."
|
||||
(popon-kill ctp--popon)
|
||||
(setq ctp--popon nil))
|
||||
|
||||
(defalias 'ctp--corfu-popupinfo--hide-advice 'ctp--close
|
||||
"Advice for `corfu-popupinfo--hide' that works in the terminal.")
|
||||
|
||||
(defun ctp--load-content (candidate buffer)
|
||||
"Load the documentation for CANDIDATE into BUFFER."
|
||||
(when-let ((content (funcall corfu-popupinfo--function candidate)))
|
||||
;; A bunch of this comes straight from `corfu-popupinfo--show'
|
||||
(with-current-buffer buffer
|
||||
(dolist (var corfu-popupinfo--buffer-parameters)
|
||||
(set (make-local-variable (car var)) (cdr var)))
|
||||
(with-silent-modifications
|
||||
(erase-buffer)
|
||||
(insert content)
|
||||
;; popon.el requires that each line be of the same width. As we are in
|
||||
;; the terminal, we assume that each character is the same width (and
|
||||
;; we can't do anything, or even know, if this is not the case). Thus,
|
||||
;; we run over the buffer to pad out each line to the width of the
|
||||
;; longest line.
|
||||
(goto-char (point-min))
|
||||
(let ((wrap-p (and (not truncate-lines) word-wrap))
|
||||
(longest-line 0))
|
||||
(cl-block nil
|
||||
(while (not (eobp))
|
||||
(let ((len (- (pos-eol) (pos-bol))))
|
||||
(when (> len longest-line)
|
||||
(setq longest-line len))
|
||||
(when (and wrap-p (> longest-line corfu-popupinfo-max-width))
|
||||
(setq longest-line corfu-popupinfo-max-width)
|
||||
(cl-return)))
|
||||
(forward-line)))
|
||||
(setq-local fill-column longest-line)
|
||||
(when wrap-p
|
||||
(fill-region (point-min) (point-max)))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(end-of-line)
|
||||
(let ((len (- (point) (pos-bol))))
|
||||
(when (< len longest-line)
|
||||
(insert (make-string (- longest-line len) ? ))))
|
||||
(forward-line))))
|
||||
(goto-char (point-min))
|
||||
(put-text-property (point-min) (point-max) 'face 'corfu-popupinfo)
|
||||
(when-let ((m (memq 'corfu-default (alist-get 'default face-remapping-alist))))
|
||||
(setcar m 'corfu-popupinfo)))
|
||||
;; We succeeded in loading the data
|
||||
t))
|
||||
|
||||
(defun ctp--popon-position (buffer)
|
||||
"Find a good position to open the popon for BUFFER's content.
|
||||
Return a list of the position, the max line length that can be shown, and the
|
||||
max height that can be shown. Each line of BUFFER _MUST_ be the same lenght."
|
||||
(when-let ((point-posn (posn-at-point))
|
||||
(point-x (car (posn-x-y point-posn)))
|
||||
(point-y (cdr (posn-x-y point-posn))))
|
||||
(with-current-buffer buffer
|
||||
(when-let ((completion-pos (popon-position corfu-terminal--popon))
|
||||
(completion-size (popon-size corfu-terminal--popon))
|
||||
(comp-x (car completion-pos))
|
||||
(comp-y (cdr completion-pos))
|
||||
(comp-w (car completion-size))
|
||||
(comp-h (cdr completion-size))
|
||||
(win-w (window-max-chars-per-line))
|
||||
(win-h (window-body-height))
|
||||
(line-len (- (pos-eol) (pos-bol)))
|
||||
(num-lines (count-lines (point-min) (point-max))))
|
||||
(let* ((align 'row)
|
||||
(width (min line-len corfu-popupinfo-max-width))
|
||||
(pop-x (cond
|
||||
((<= (+ comp-x comp-w width) win-w)
|
||||
(+ comp-x comp-w))
|
||||
((>= (- comp-x width) 0)
|
||||
(- comp-x width))
|
||||
((<= (+ comp-x width) win-w)
|
||||
(setq align 'col)
|
||||
comp-x)
|
||||
((>= (- win-w width) 0)
|
||||
(setq align 'col)
|
||||
(- win-w width))
|
||||
(t
|
||||
(setq align 'col
|
||||
width win-w)
|
||||
0)))
|
||||
(height (min num-lines corfu-popupinfo-max-height))
|
||||
(pop-y (cl-case align
|
||||
(row (if (<= (+ comp-y height) win-h)
|
||||
comp-y
|
||||
(max 0 (- win-h height))))
|
||||
(col (cond
|
||||
((<= (+ comp-y comp-h height)
|
||||
(- win-h scroll-margin))
|
||||
(+ comp-y comp-h))
|
||||
;; If the completion dialog is above the point
|
||||
((and (< comp-y point-y)
|
||||
(>= (- comp-y height) 0))
|
||||
(- comp-y height))
|
||||
;; Emacs seems to hide the current text if this
|
||||
;; number is 1 (I think it's too close to two
|
||||
;; overlays)
|
||||
((>= (- comp-y height 2) 0)
|
||||
(- comp-y height 2))
|
||||
(t (+ comp-y comp-h)))))))
|
||||
(list (cons pop-x pop-y) width height))))))
|
||||
|
||||
(defun ctp--extract-content (buffer width height)
|
||||
"Extract the content from BUFFER for a popon.
|
||||
The content extracted is for a popon of size WIDTH by HEIGHT."
|
||||
(let (start end)
|
||||
(with-current-buffer buffer
|
||||
;; we assume that we are scrolled to the start of the region we care about
|
||||
(save-excursion
|
||||
(let ((rem-lines (count-lines (point) (point-max))))
|
||||
(when (< rem-lines height)
|
||||
(forward-line (- rem-lines height))))
|
||||
(setq start (point)
|
||||
end (pos-eol height))))
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring buffer start end)
|
||||
(goto-char (point-min))
|
||||
(cl-loop repeat height
|
||||
until (eobp) do
|
||||
(let ((len (- (pos-eol) (pos-bol))))
|
||||
(when (> len width)
|
||||
(delete-region (+ (pos-bol) width) (pos-eol))))
|
||||
(forward-line))
|
||||
;; "delete" the rest of the lines
|
||||
(narrow-to-region (point-min) (point))
|
||||
(buffer-string))))
|
||||
|
||||
(defun ctp--display-buffer (buffer)
|
||||
"Display or redisplay BUFFER in a popon."
|
||||
(let ((inhibit-redisplay t))
|
||||
(cl-destructuring-bind (&optional pos width height)
|
||||
(ctp--popon-position buffer)
|
||||
(popon-kill ctp--popon)
|
||||
(when-let ((pos)
|
||||
(content (ctp--extract-content buffer width height)))
|
||||
(setq ctp--popon
|
||||
;; appear behind the auto-complete window, in case something
|
||||
;; happens
|
||||
(popon-create content pos nil nil 100))))))
|
||||
|
||||
(defun ctp--corfu-popupinfo--show-advice (oldfun candidate)
|
||||
"Advice for `corfu-popupinfo--show' that works in the terminal.
|
||||
CANDIDATE is the same as for `corfu-popupinfo--show'. As this is meant to be
|
||||
:around advice, OLDFUN is assumed to be the real (advised) function."
|
||||
(if (display-graphic-p)
|
||||
(progn
|
||||
(popon-kill ctp--popon)
|
||||
(funcall oldfun candidate))
|
||||
(when corfu-popupinfo--timer
|
||||
(cancel-timer corfu-popupinfo--timer)
|
||||
(setq corfu-popupinfo--timer nil))
|
||||
(when (and (frame-live-p corfu-popupinfo--frame)
|
||||
(frame-visible-p corfu-popupinfo--frame))
|
||||
(corfu--hide-frame corfu-popupinfo--frame))
|
||||
(when (or (not (ctp--visible-p))
|
||||
(not (corfu--equal-including-properties
|
||||
candidate corfu-popupinfo--candidate)))
|
||||
(let ((buf (ctp--get-buffer)))
|
||||
(if (ctp--load-content candidate buf)
|
||||
(progn
|
||||
(ctp--display-buffer buf)
|
||||
(setq corfu-popupinfo--candidate candidate
|
||||
corfu-popupinfo--toggle t))
|
||||
(corfu-popupinfo--hide))))))
|
||||
|
||||
(defun ctp--move-away-from-eob ()
|
||||
"Ensure the point isn't too close to the end of the buffer."
|
||||
(if-let ((total-lines (count-lines (point-min) (point-max)))
|
||||
((> total-lines corfu-popupinfo-max-height))
|
||||
(rem-lines (count-lines (point) (point-max)))
|
||||
((< rem-lines corfu-popupinfo-max-height)))
|
||||
(forward-line (- (- corfu-popupinfo-max-height rem-lines)))))
|
||||
|
||||
(defun ctp--corfu-popupinfo-scroll-up-advice
|
||||
(oldfun &optional n)
|
||||
"Advice for `corfu-popupinfo-scroll-up'.
|
||||
N is the number of lines. As this is :around advice, OLDFUN is the real
|
||||
\(advised) function."
|
||||
(if (ctp--visible-p)
|
||||
(let ((buf (ctp--get-buffer)))
|
||||
(with-current-buffer buf
|
||||
(forward-line n)
|
||||
(beginning-of-line)
|
||||
(ctp--move-away-from-eob))
|
||||
(ctp--display-buffer buf))
|
||||
(funcall oldfun n)))
|
||||
|
||||
(defun ctp--corfu-popupinfo-end-advice (oldfun &optional n)
|
||||
"Advice for `corfu-popupinfo-end'.
|
||||
N is the same as for `corfu-popupinfo-end'. As this is :around advice, OLDFUN
|
||||
is the real (advised) function."
|
||||
(if (ctp--visible-p)
|
||||
(let ((buf (ctp--get-buffer)))
|
||||
(with-current-buffer buf
|
||||
(let ((size (- (point-max) (point-min))))
|
||||
(goto-char (if n
|
||||
(- (point-max) (/ (* size n) 10))
|
||||
(point-max))))
|
||||
(beginning-of-line)
|
||||
(ctp--move-away-from-eob))
|
||||
(ctp--display-buffer buf))
|
||||
(funcall oldfun n)))
|
||||
|
||||
(defun ctp--corfu--popup-hide-advice ()
|
||||
":after advice for `corfu--popup-hide'."
|
||||
(unless completion-in-region-mode
|
||||
(ctp--close)))
|
||||
|
||||
(defun ctp--enable ()
|
||||
"Enable corfu terminal popupinfo by advising some corfu functions."
|
||||
(advice-add 'corfu-popupinfo--visible-p :around
|
||||
'ctp--corfu-popupinfo--visible-p-advice)
|
||||
(advice-add 'corfu-popupinfo--hide :after
|
||||
'ctp--corfu-popupinfo--hide-advice)
|
||||
(advice-add 'corfu-popupinfo--show :around
|
||||
'ctp--corfu-popupinfo--show-advice)
|
||||
(advice-add 'corfu-popupinfo-scroll-up :around
|
||||
'ctp--corfu-popupinfo-scroll-up-advice)
|
||||
(advice-add 'corfu-popupinfo-end :around
|
||||
'ctp--corfu-popupinfo-end-advice)
|
||||
(advice-add 'corfu--popup-hide :after
|
||||
'ctp--corfu--popup-hide-advice))
|
||||
|
||||
(defun ctp--disable ()
|
||||
"Disable corfu terminal popupinfo by remove advice added by `ctp--enable'."
|
||||
(ctp--close)
|
||||
(advice-remove 'corfu-popupinfo--visible-p
|
||||
'ctp--corfu-popupinfo--visible-p-advice)
|
||||
(advice-remove 'corfu-popupinfo--hide
|
||||
'ctp--corfu-popupinfo--hide-advice)
|
||||
(advice-remove 'corfu-popupinfo--show
|
||||
'ctp--corfu-popupinfo--show-advice)
|
||||
(advice-remove 'corfu-popupinfo-scroll-up
|
||||
'ctp--corfu-popupinfo-scroll-up-advice)
|
||||
(advice-remove 'corfu-popupinfo-end
|
||||
'ctp--corfu-popupinfo-end-advice)
|
||||
(advice-remove 'corfu--popup-hide
|
||||
'ctp--corfu--popup-hide-advice))
|
||||
|
||||
(defun ctp--corfu-terminal-mode-hook ()
|
||||
"Hook run from `corfu-terminal-mode-hook'."
|
||||
(if (and corfu-terminal-mode
|
||||
(bound-and-true-p corfu-terminal-popupinfo-mode))
|
||||
(ctp--enable)
|
||||
(ctp--disable)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode corfu-terminal-popupinfo-mode
|
||||
"Minor mode shows the `corfu-popupinfo-mode' popup in the terminal.
|
||||
Note that even with this enabled, you still need to enable the actual popup
|
||||
using `corfu-popupinfo-toggle'. Also, this does not do anything if
|
||||
`corfu-terminal-mode' is not enabled."
|
||||
:global t
|
||||
:group 'corfu-terminal-popupinfo
|
||||
(if corfu-terminal-popupinfo-mode
|
||||
(progn
|
||||
(add-hook 'corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
|
||||
(when corfu-terminal-mode
|
||||
(ctp--enable)))
|
||||
(remove-hook 'corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
|
||||
(ctp--disable)))
|
||||
|
||||
(provide 'corfu-terminal-popupinfo)
|
||||
;;; corfu-terminal-popupinfo.el ends here
|
File diff suppressed because it is too large
Load Diff
@ -1,134 +1,862 @@
|
||||
;;; firejail-mode --- Major mode for editing firejail profiles -*- lexical-binding: t -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
(require 'find-file)
|
||||
(require 'custom)
|
||||
(require 'thingatpt)
|
||||
(require 'man)
|
||||
|
||||
(eval-when-compile
|
||||
(require 'rx))
|
||||
|
||||
(defgroup firejail-mode ()
|
||||
"Major mode for editing Firejail profiles."
|
||||
:group 'programming
|
||||
:prefix "firejail-")
|
||||
|
||||
(defcustom firejail-executable "firejail"
|
||||
"Executable to use when calling firejail."
|
||||
:tag "Executable"
|
||||
:group 'firejail-mode
|
||||
:type 'string)
|
||||
|
||||
(defcustom firejail-include-search-directories
|
||||
'("./" "~/.config/firejail/" "/etc/firejail/" "/usr/local/etc/firejail/")
|
||||
"List of directories to search for include files."
|
||||
:tag "Include Search Directories"
|
||||
:group 'firejail-mode
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom firejail-include-search-suffixes
|
||||
'("inc" "local" "profile")
|
||||
"List of file suffixes to use when searching for include files.
|
||||
These should _NOT_ have a leading period."
|
||||
:tag "Include Search Suffixes"
|
||||
:group 'firejail-mode
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom firejail-include-ignored-files
|
||||
'(".git/")
|
||||
"List of file names that should be ignored when searching for include files.
|
||||
These should end with a slash (/) if their are a directory."
|
||||
:tag "Include Ignored Files"
|
||||
:group 'firejail-mode
|
||||
:type '(repeat string))
|
||||
|
||||
(defface firejail-error-face
|
||||
'((t :background "red"))
|
||||
"Face for reporting Firejail syntax errors."
|
||||
:tag "Error Face"
|
||||
:group 'firejail-mode)
|
||||
|
||||
(defun firejail--debug-output-to-list (&rest args)
|
||||
"Convert the output from one of Firejail's --debug-* commands to a list.
|
||||
ARGS are passed uncaged to Firejail and should include the proper debug command."
|
||||
(ignore-error file-missing
|
||||
(mapcan (lambda (line)
|
||||
(when (string-match (rx "- " (group (+ any)) eol) line)
|
||||
(list (match-string 1 line))))
|
||||
(apply 'process-lines firejail-executable args))))
|
||||
|
||||
(defconst firejail--known-caps
|
||||
(firejail--debug-output-to-list "--debug-caps")
|
||||
"A list of known Linux capabilities.
|
||||
This will probably be empty on anything but Linux.")
|
||||
|
||||
(defconst firejail--known-syscalls64
|
||||
(firejail--debug-output-to-list "--debug-syscalls")
|
||||
"A list of known 64 bit system calls.
|
||||
This will probably be empty on anything by Linux.")
|
||||
|
||||
(defconst firejail--known-syscalls32
|
||||
(firejail--debug-output-to-list "--debug-syscalls32")
|
||||
"A list of known system 32 bit calls.
|
||||
This will probably be empty on anything by Linux.")
|
||||
|
||||
(defconst firejail--known-errnos
|
||||
(firejail--debug-output-to-list "--debug-errnos")
|
||||
"A list of known system 32 bit calls.
|
||||
This will probably be empty on anything by Linux.")
|
||||
|
||||
(defconst firejail--known-conditionals
|
||||
'("HAS_APPIMAGE" "HAS_NET" "HAS_NODBUS" "HAS_NOSOUND" "HAS_PRIVATE"
|
||||
"HAS_X11" "ALLOW_TRAY" "BROWSER_DISABLE_U2F" "BROWSER_ALLOW_DRM")
|
||||
"List of conditionals known to Firejail.")
|
||||
|
||||
(defun firejail--list-dbus-services (bus)
|
||||
"List all DBus services on BUS.
|
||||
BUS is one of `:system' or `:session'."
|
||||
(ignore-errors
|
||||
(require 'dbus nil t)
|
||||
(when (fboundp 'dbus-call-method) ;; silence byte compiler
|
||||
(dbus-call-method bus "org.freedesktop.DBus" "/org/freedesktop/DBus"
|
||||
"org.freedesktop.DBus" "ListNames"))))
|
||||
|
||||
(defun firejail--insert-entire-special-file (file)
|
||||
"Insert all of FILE (e.g. /proc/cpuinfo), even if it's special."
|
||||
(while (>= (cl-second (insert-file-contents file nil (1- (point))
|
||||
(+ (point) 9999)))
|
||||
10000)
|
||||
(goto-char (point-max))))
|
||||
|
||||
(defvar-local firejail--num-cpus-cache nil
|
||||
"The number of CPUs the current system has.
|
||||
This might be nil on platforms other than Linux.")
|
||||
|
||||
(defun firejail--get-num-cpus ()
|
||||
"Return the number of CPUs the current system has."
|
||||
(if (local-variable-p 'firejail--num-cpus-cache)
|
||||
firejail--num-cpus-cache
|
||||
(ignore-error file-missing
|
||||
(with-temp-buffer
|
||||
(firejail--insert-entire-special-file "/proc/cpuinfo")
|
||||
(goto-char (point-max))
|
||||
(when (re-search-backward (rx bol "processor" blank ":" blank
|
||||
(group (+ digit)) eol))
|
||||
(setq firejail--num-cpus-cache
|
||||
(string-to-number (match-string-no-properties 1))))))))
|
||||
|
||||
(defun firejail--find-next-glob-char (limit)
|
||||
"Find the next glob char between point and LIMIT."
|
||||
(let ((max-lisp-eval-depth 10000))
|
||||
(when (search-forward "*" limit t)
|
||||
(backward-char)
|
||||
(if (not (eq t (nth 5 (syntax-ppss))))
|
||||
(progn
|
||||
(looking-at (regexp-quote "*"))
|
||||
(forward-char)
|
||||
t)
|
||||
(forward-char)
|
||||
(firejail--find-next-glob-char limit)))))
|
||||
|
||||
(defun firejail--generate-documentation-table ()
|
||||
"Parse the firejail-profile(5) man page to get a documentation table."
|
||||
(ignore-error file-missing
|
||||
(let ((path (car (process-lines-handling-status
|
||||
manual-program (lambda (status)
|
||||
(when (not (zerop status))
|
||||
(signal 'file-missing "")))
|
||||
"-w" "firejail-profile")))
|
||||
(ht (make-hash-table)))
|
||||
(with-temp-buffer
|
||||
;; Emacs will auto unzip this if needed
|
||||
(insert-file-contents path)
|
||||
(when (re-search-forward (rx bol ".TP\n"
|
||||
bol "\\fBinclude other.profile" eol)
|
||||
nil t)
|
||||
(forward-line -1)
|
||||
(while (and (not (looking-at-p (rx bol ".SH FILES" eol)))
|
||||
(re-search-forward (rx bol ".TP\n" bol
|
||||
"\\fB" (group
|
||||
(+ (not (any "\n" blank)))))
|
||||
nil t))
|
||||
(let ((name (intern (match-string-no-properties 1)))
|
||||
(start (+ 3 (pos-bol))))
|
||||
(when (re-search-forward (rx bol ".TP" eol) nil t)
|
||||
(forward-line -1)
|
||||
(when (looking-at-p (rx bol eol))
|
||||
(forward-line -1))
|
||||
(let* ((raw-doc (buffer-substring-no-properties
|
||||
start (pos-eol)))
|
||||
(new-doc (replace-regexp-in-string (rx bol ".br" eol)
|
||||
"\n" raw-doc))
|
||||
(cur-doc (gethash name ht)))
|
||||
(puthash name (concat cur-doc
|
||||
(when cur-doc "\n\n")
|
||||
new-doc)
|
||||
ht)))))))
|
||||
;; some manual fixing
|
||||
(cl-macrolet ((summary (dir text)
|
||||
`(let ((old-val (gethash ',dir ht)))
|
||||
(puthash ',dir (concat (symbol-name ',dir) "\n"
|
||||
,text (when old-val "\n\n")
|
||||
old-val)
|
||||
ht))))
|
||||
(summary net "Enable a new network namespace.")
|
||||
(summary bind "Mount bind directories or files."))
|
||||
ht)))
|
||||
|
||||
(defvar-local firejail--documentation-table nil
|
||||
"Table mapping Firejail directives to their documentation.")
|
||||
|
||||
(defun firejail--documentation-for (dir)
|
||||
"Lookup the documentation for DIR."
|
||||
(unless firejail--documentation-table
|
||||
(setq firejail--documentation-table
|
||||
(firejail--generate-documentation-table)))
|
||||
(gethash (intern-soft dir) firejail--documentation-table))
|
||||
|
||||
(defconst firejail-profile-font-lock-keywords
|
||||
(let* ((normal '("quiet" "include" "noblacklist" "nowhitelist"
|
||||
"blacklist" "blacklist-nolog" "bind" "disable-mnt"
|
||||
"keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
|
||||
"mkdir" "mkfile" "noexec" "private" "private-bin"
|
||||
"private-cache" "private-cwd" "private-dev"
|
||||
"private-etc" "private-home" "private-lib"
|
||||
"private-opt" "private-srv" "private-tmp"
|
||||
"read-only" "read-write" "tmpfs" "tracelog"
|
||||
"whitelist" "whitelist-ro" "writable-etc"
|
||||
"writable-run-user" "writable-var"
|
||||
"writable-var-log" "allow-debuggers" "apparmor"
|
||||
"caps" "caps.keep" "caps.drop"
|
||||
"memory-deny-write-execute" "nonewprivs"
|
||||
"noprinters" "noroot" "restrict-namespaces"
|
||||
"seccomp" "seccomp.32" "seccomp.drop"
|
||||
"seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
|
||||
"protocol" "xephyr-screen" "dbus-system.own"
|
||||
"dbus-system.talk" "dbus-system.see"
|
||||
"dbus-system.call" "dbus-system.broadcast"
|
||||
"dbus-user.own" "dbus-user.talk" "dbus-user.see"
|
||||
"dbus-user.call" "dbus-user.broadcast" "nodbus"
|
||||
"cpu" "nice" "rlimit-as" "rlimit-cpu"
|
||||
"rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
|
||||
"rlimit-sigpending" "timeout" "allusers" "env"
|
||||
"ipc-namespace" "keep-fd" "name" "no3d"
|
||||
"noautopulse" "nodvd" "nogroups" "noinput"
|
||||
"nosound" "notv" "nou2f" "novideo" "machine-id"
|
||||
"defaultgw" "dns" "hostname" "hosts-file" "x11"
|
||||
"dbus-system" "dbus-user" "ip" "ip6" "iprange"
|
||||
"mac" "mtu" "net" "netfilter" "netfilter" "netlock"
|
||||
"netmask" "netns" "veth-name"
|
||||
"deterministic-exit-code" "deterministic-shutdown"
|
||||
"join-or-start"))
|
||||
(take-all-list '("caps.drop"))
|
||||
(take-none-list '("shell" "net"))
|
||||
(comment-rx '("^.*\\(#.*\\)$" 1 font-lock-comment-face))
|
||||
(dbus-system-user-rx '("^ *\\(\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(ignore +\\)?\
|
||||
dbus-\\(system\\|user\\) +\\(none\\|filter\\)?\\)" . 2))
|
||||
(x11-rx '("^ *\\(?:\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(?:ignore +\\)?x11 +\\(?:none\\|xephyr\\|xorg\\|xpra\\|xvfb\\)?\\)" . 1))
|
||||
(ip-ip6-rx '("^ *\\(\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(ignore +\\)?ip6? +\\(none\\|dhcp\\)\\)" . 2))
|
||||
(take-all `(,(concat (regexp-opt take-all-list "^ *\\(\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(ignore +\\)?\\<\\(") "\\>\\)")
|
||||
(2 font-lock-keyword-face)
|
||||
("\\<all\\>" nil nil (0 font-lock-keyword-face))))
|
||||
(take-none `(,(concat (regexp-opt take-none-list "^ *\\(\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(ignore +\\)?\\<\\(") "\\>\\)")
|
||||
(2 font-lock-keyword-face)
|
||||
("\\<none\\>" nil nil (0 font-lock-keyword-face))))
|
||||
(protocol '("^ *\\(\\?A+: +\\)?\
|
||||
\\(\\(ignore +\\)?\\<protocol\\>\\)" (2 font-lock-keyword-face)
|
||||
("\\<unix\\>" nil nil (0 font-lock-keyword-face))
|
||||
("\\<inet\\>" nil nil (0 font-lock-keyword-face))
|
||||
("\\<inet6\\>" nil nil (0 font-lock-keyword-face))
|
||||
("\\<netlink\\>" nil nil (0 font-lock-keyword-face))
|
||||
("\\<packet\\>" nil nil (0 font-lock-keyword-face))
|
||||
("\\<bluetooth\\>" nil nil (0 font-lock-keyword-face))))
|
||||
(variable-rx '("\\${[A-Za-z_]*}" 0 font-lock-variable-name-face))
|
||||
(normal-rx `(,(concat (regexp-opt normal "^ *\\(\\?[A-Z_]+: +\\)?\
|
||||
\\(\\(ignore +\\)?\\<\\(") "\\>\\)") . 2)))
|
||||
(list comment-rx x11-rx ip-ip6-rx take-all take-none protocol
|
||||
dbus-system-user-rx normal-rx variable-rx
|
||||
'("^ *\\(\\?[A-Z_]+: +\\)?\\(\\<ignore\\>\\)" . 2)))
|
||||
(let* ((cond-rx (rx (* space) "?" (group (* (any alnum "_"))) (? ":")))
|
||||
(ignore-rx (rx (group (+ (* space) bow "ignore"))))
|
||||
(prefix-rx (rx bol (? (regexp cond-rx)) (? (regexp ignore-rx))
|
||||
(* space)))
|
||||
kwds)
|
||||
(cl-flet ((add (dirs &optional opts (face 'font-lock-keyword-face))
|
||||
(push (list
|
||||
(rx (regexp prefix-rx)
|
||||
bow (regexp (regexp-opt (ensure-list dirs) t)) eow
|
||||
(* space)
|
||||
(? (regexp (regexp-opt (ensure-list opts) t)) eow))
|
||||
'(1 font-lock-builtin-face nil t)
|
||||
'(2 font-lock-keyword-face nil t)
|
||||
'(3 font-lock-keyword-face)
|
||||
`(4 ,face nil t))
|
||||
kwds))
|
||||
(add-many (dirs opts &optional (face 'font-lock-keyword-face))
|
||||
(push (list
|
||||
(rx (regexp prefix-rx)
|
||||
bow (regexp (regexp-opt (ensure-list dirs) t)) eow)
|
||||
'(1 font-lock-builtin-face nil t)
|
||||
'(2 font-lock-keyword-face nil t)
|
||||
'(3 font-lock-keyword-face)
|
||||
`(,(rx bow (regexp (regexp-opt opts t)) eow)
|
||||
nil nil (0 ,face)))
|
||||
kwds)))
|
||||
;; NOTE the order below matters
|
||||
;; glob asterisk
|
||||
(push '("*" 0 'bold append) kwds)
|
||||
;; invalid characters
|
||||
(push `(,(rx (or "\"" "\\")) 0 'firejail-error-face t) kwds)
|
||||
;; variables
|
||||
(push (list (rx "${" (+ (any alnum "_")) "}") 0
|
||||
'font-lock-variable-name-face t)
|
||||
kwds)
|
||||
;; ignore
|
||||
(push (list (rx bol (? (regexp cond-rx)) (regexp ignore-rx) eow)
|
||||
2 'font-lock-keyword-face)
|
||||
kwds)
|
||||
;; conditional
|
||||
(push (list (rx bol (regexp cond-rx) eow) 1 'font-lock-builtin-face) kwds)
|
||||
;; can't have a conditional include or quiet
|
||||
(push (list (rx bol (? (regexp ignore-rx)) (* space)
|
||||
bow (group (or "include" "quiet")) eow)
|
||||
2 'font-lock-keyword-face)
|
||||
kwds)
|
||||
;; directives
|
||||
(add '("noblacklist" "nowhitelist" "blacklist" "blacklist-nolog" "bind"
|
||||
"disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
|
||||
"mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
|
||||
"private-cwd" "private-dev" "private-etc" "private-home"
|
||||
"private-lib" "private-opt" "private-srv" "private-tmp" "read-only"
|
||||
"read-write" "tmpfs" "tracelog" "whitelist" "whitelist-ro"
|
||||
"writable-etc" "writable-run-user" "writable-var"
|
||||
"writable-var-log" "allow-debuggers" "apparmor" "caps" "caps.keep"
|
||||
"caps.drop" "memory-deny-write-execute" "nonewprivs" "noprinters"
|
||||
"noroot" "restrict-namespaces" "seccomp" "seccomp.32"
|
||||
"seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
|
||||
"seccomp.block-secondary" "protocol" "xephyr-screen"
|
||||
"dbus-system.own" "dbus-system.talk" "dbus-system.see"
|
||||
"dbus-system.call" "dbus-system.broadcast" "dbus-user.own"
|
||||
"dbus-user.talk" "dbus-user.see" "dbus-user.call"
|
||||
"dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
|
||||
"rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
|
||||
"rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace"
|
||||
"keep-fd" "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput"
|
||||
"nosound" "notv" "nou2f" "novideo" "machine-id" "defaultgw" "dns"
|
||||
"hostname" "hosts-file" "x11" "dbus-system" "dbus-user" "ip" "ip6"
|
||||
"iprange" "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
|
||||
"netmask" "netns" "veth-name" "deterministic-exit-code"
|
||||
"deterministic-shutdown" "join-or-start"))
|
||||
(add "caps.drop" "all")
|
||||
(add '("net" "shell") "none")
|
||||
(add '("dbus-system" "dbus-user") '("none" "filter"))
|
||||
(add '("ip" "ip6") '("none" "dhcp"))
|
||||
(add "x11" '("none" "xephyr" "xorg" "xpra" "xvfb"))
|
||||
(add-many "restrict-namespaces" '("cgroup" "ipc" "net" "mnt"
|
||||
"time" "user" "uts"))
|
||||
(add-many "protocol" '("unix" "inet" "inet6" "netlink"
|
||||
"packet" "bluetooth"))
|
||||
(add-many '("caps.drop" "caps.keep")
|
||||
firejail--known-caps 'font-lock-builtin-face)
|
||||
(add-many '("seccomp" "seccomp.drop" "seccomp.keep")
|
||||
firejail--known-syscalls64 'font-lock-builtin-face)
|
||||
(add-many '("seccomp.32" "seccomp.32.drop" "seccomp.32.keep")
|
||||
firejail--known-syscalls32 'font-lock-builtin-face)
|
||||
(add "seccomp-error-action" '("kill" "log"))
|
||||
(add "seccomp-error-action" firejail--known-errnos
|
||||
'font-lock-builtin-face)
|
||||
kwds))
|
||||
"Highlight keywords for `firejail-profile-mode'.")
|
||||
|
||||
(defvar firejail-profile-syntax-table
|
||||
(let ((syn-table (make-syntax-table)))
|
||||
(modify-syntax-entry ?# "<" syn-table)
|
||||
(modify-syntax-entry ?\n ">" syn-table)
|
||||
(modify-syntax-entry ?\" "." syn-table)
|
||||
(modify-syntax-entry ?\( "." syn-table)
|
||||
(modify-syntax-entry ?\) "." syn-table)
|
||||
(modify-syntax-entry ?\[ "." syn-table)
|
||||
(modify-syntax-entry ?\] "." syn-table)
|
||||
syn-table)
|
||||
"Syntax table for `firejail-profile-mode'.")
|
||||
|
||||
(defconst firejail-profile--keyword-list
|
||||
'("quiet" "include" "noblacklist" "nowhitelist" "blacklist"
|
||||
"blacklist-nolog" "bind" "disable-mnt" "keep-config-pulse"
|
||||
"keep-dev-shm" "keep-var-tmp" "mkdir" "mkfile" "noexec" "private"
|
||||
"private-bin" "private-cache" "private-cwd" "private-dev"
|
||||
"private-etc" "private-home" "private-lib" "private-opt"
|
||||
"private-srv" "private-tmp" "read-only" "read-write" "tmpfs"
|
||||
"tracelog" "whitelist" "whitelist-ro" "writable-etc"
|
||||
"writable-run-user" "writable-var" "writable-var-log"
|
||||
"allow-debuggers" "apparmor" "caps" "caps.keep" "caps.drop"
|
||||
"memory-deny-write-execute" "nonewprivs" "noprinters" "noroot"
|
||||
"restrict-namespaces" "seccomp" "seccomp.32" "seccomp.drop"
|
||||
"seccomp.32.drop" "seccomp.keep" "seccomp.32.keep" "protocol"
|
||||
"xephyr-screen" "dbus-system.own" "dbus-system.talk"
|
||||
"dbus-system.see" "dbus-system.call" "dbus-system.broadcast"
|
||||
"dbus-user.own" "dbus-user.talk" "dbus-user.see" "dbus-user.call"
|
||||
"dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
|
||||
'("ignore" "include" "noblacklist" "nowhitelist" "blacklist" "blacklist-nolog"
|
||||
"bind" "disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
|
||||
"mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
|
||||
"private-cwd" "private-dev" "private-etc" "private-home" "private-lib"
|
||||
"private-opt" "private-srv" "private-tmp" "read-only" "read-write" "tmpfs"
|
||||
"tracelog" "whitelist" "whitelist-ro" "writable-etc" "writable-run-user"
|
||||
"writable-var" "writable-var-log" "allow-debuggers" "apparmor" "caps"
|
||||
"caps.keep" "caps.drop" "memory-deny-write-execute" "nonewprivs"
|
||||
"noprinters" "noroot" "restrict-namespaces" "seccomp" "seccomp.32"
|
||||
"seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
|
||||
"seccomp.block-secondary" "seccomp-error-action" "protocol" "xephyr-screen"
|
||||
"dbus-system.own" "dbus-system.talk" "dbus-system.see" "dbus-system.call"
|
||||
"dbus-system.broadcast" "dbus-user.own" "dbus-user.talk" "dbus-user.see"
|
||||
"dbus-user.call" "dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
|
||||
"rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
|
||||
"rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace"
|
||||
"keep-fd" "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput"
|
||||
"nosound" "notv" "nou2f" "novideo" "machine-id" "defaultgw" "dns"
|
||||
"hostname" "hosts-file" "x11" "dbus-system" "dbus-user" "ip" "ip6"
|
||||
"iprange" "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
|
||||
"netmask" "netns" "veth-name" "deterministic-exit-code" "ignore"
|
||||
"deterministic-shutdown" "join-or-start" "net" "shell" "protocol")
|
||||
"rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace" "keep-fd"
|
||||
"name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput" "nosound" "notv"
|
||||
"nou2f" "novideo" "machine-id" "defaultgw" "dns" "hostname" "hosts-file"
|
||||
"x11" "dbus-system" "dbus-user" "ip" "ip6" "iprange" "mac" "mtu" "net"
|
||||
"netfilter" "netfilter" "netlock" "netmask" "netns" "veth-name"
|
||||
"deterministic-exit-code" "deterministic-shutdown" "join-or-start" "net"
|
||||
"shell" "protocol")
|
||||
"List of keywords used for `firejail-profile-capf'.")
|
||||
|
||||
(defun firejail--symlink-directory-p (symlink)
|
||||
"Return non-nil if SYMLINK has a directory at the end of its chain."
|
||||
(file-directory-p (file-truename symlink)))
|
||||
|
||||
(defun firejail--collect-includes (&optional relative-to)
|
||||
"Return a list of files that the user is likely to want to include.
|
||||
With RELATIVE-TO, return a list of files relative to each directory in it."
|
||||
(let ((pat (concat "\\." (regexp-opt firejail-include-search-suffixes) "\\'"))
|
||||
(buffer-file (file-name-nondirectory
|
||||
(directory-file-name (buffer-file-name)))))
|
||||
(seq-difference
|
||||
(mapcan (lambda (dir)
|
||||
(ignore-error file-missing
|
||||
(cl-loop for (name type) in (directory-files-and-attributes dir)
|
||||
when (or (and (eq t type)
|
||||
(not (member name (list "." ".."))))
|
||||
(and (stringp type)
|
||||
(firejail--symlink-directory-p type)))
|
||||
collect (concat name "/")
|
||||
when (and (string-match-p pat name)
|
||||
(not (equal name buffer-file))
|
||||
(not (auto-save-file-name-p name))
|
||||
(not (backup-file-name-p name)))
|
||||
collect name)))
|
||||
(or (ensure-list relative-to) firejail-include-search-directories))
|
||||
firejail-include-ignored-files)))
|
||||
|
||||
(defun firejail--include-completion-table (current-input)
|
||||
"Return completion table for file name based on CURRENT-INPUT.
|
||||
The completion table contains just the last component. Therefore, the capf
|
||||
should specify the START position of this table to be the first character after
|
||||
the last slash (/) on the line. If none of that made sense, see the
|
||||
documentation for `completion-at-point-functions'."
|
||||
(if-let ((last-slash (cl-position ?/ current-input :from-end t))
|
||||
(base (file-truename
|
||||
(substring current-input 0 (1+ last-slash)))))
|
||||
(let ((default-directory base))
|
||||
(firejail--collect-includes default-directory))
|
||||
(firejail--collect-includes)))
|
||||
|
||||
(defun firejail--guess-system-cfg-directory ()
|
||||
"Guess the system config directory.
|
||||
The return value will have a trailing slash."
|
||||
(or (cl-find-if 'file-directory-p
|
||||
'("/etc/firejail/" "/usr/local/etc/firejail/"))
|
||||
"/etc/firejail/"))
|
||||
|
||||
(defun firejail--exec-path ()
|
||||
"Parse the PATH environment variable.
|
||||
Return a list of files."
|
||||
(cl-loop for (dir . rest) = exec-path then rest
|
||||
while rest ;; ignore last element
|
||||
collect (file-name-as-directory dir)))
|
||||
|
||||
(defun firejail--parse-file-argument (arg)
|
||||
"Parse ARG by resolving variables.
|
||||
This will return a list. This is because the PATH variable has many directories
|
||||
in it."
|
||||
(if (string-match (rx "${" (group (or "HOME" "CFG" "PATH"
|
||||
"RUNUSER")) "}" (? "/")) arg)
|
||||
(let ((var (match-string 1 arg))
|
||||
(rest (substring arg (match-end 0))))
|
||||
(cond
|
||||
((equal var "HOME")
|
||||
(list (concat (expand-file-name "~/") rest)))
|
||||
((equal var "CFG")
|
||||
(list (concat (firejail--guess-system-cfg-directory) rest)))
|
||||
((equal var "RUNUSER")
|
||||
(list (concat (file-name-as-directory (getenv "XDG_RUNTIME_DIR"))
|
||||
rest)))
|
||||
((equal var "PATH")
|
||||
(mapcar (lambda (elt)
|
||||
(concat elt rest))
|
||||
(firejail--exec-path)))))
|
||||
(list arg)))
|
||||
|
||||
(defun firejail--file-completion-table (current-input &optional dir-only)
|
||||
"Generate a completion table for files.
|
||||
CURRENT-INPUT is the current text of the argument to complete. With DIR-ONLY,
|
||||
only report directory completions."
|
||||
(ignore-error file-missing
|
||||
(let ((dir (if-let ((last-idx (cl-position ?/ current-input
|
||||
:from-end t)))
|
||||
(substring current-input 0 (1+ last-idx))
|
||||
current-input)))
|
||||
(cl-loop for (name type) in (directory-files-and-attributes dir)
|
||||
when (or (and (eq t type)
|
||||
(not (member name '("." ".."))))
|
||||
(and (stringp type)
|
||||
(firejail--symlink-directory-p type)))
|
||||
collect (concat name "/")
|
||||
unless (or type dir-only)
|
||||
collect name))))
|
||||
|
||||
(defun firejail--move-over-string-chars (count)
|
||||
"Move over COUNT characters, assuming the point is inside a string.
|
||||
This may move over more than COUNT characters if the string contains escapes."
|
||||
(cl-loop repeat count
|
||||
do (cl-loop with read-buf = (string (char-after))
|
||||
for read-val = (condition-case nil
|
||||
(read (concat "\"" read-buf "\""))
|
||||
(end-of-file))
|
||||
until read-val
|
||||
do (forward-char) and
|
||||
do (setq read-buf (concat read-buf (string
|
||||
(char-after))))
|
||||
finally (forward-char)
|
||||
finally return read-val)))
|
||||
|
||||
(defun firejail--complete-file-from-table (table-fn index args)
|
||||
"Complete INDEX of ARGS using TABLE-FN.
|
||||
TABLE-FN should be a function of one argument that takes the current arg and
|
||||
returns a completion table for it."
|
||||
(cl-destructuring-bind (start _end text) (nth index args)
|
||||
(let* ((base (or (file-name-directory text) ""))
|
||||
(table (funcall table-fn base)))
|
||||
(list (+ start (length base)) (+ start (length text)) table))))
|
||||
|
||||
(defun firejail--complete-include (index args _directive)
|
||||
"Complete an include directive's arg numbered INDEX of ARGS."
|
||||
(firejail--complete-file-from-table #'firejail--include-completion-table
|
||||
index args))
|
||||
|
||||
(defun firejail--complete-file (index args _directive)
|
||||
"Complete file taking directive's arg numbered INDEX of ARGS."
|
||||
(firejail--complete-file-from-table #'firejail--file-completion-table
|
||||
index args))
|
||||
|
||||
(defun firejail--complete-directory (index args _directive)
|
||||
"Complete directory taking directive's arg numbered INDEX of ARGS."
|
||||
(firejail--complete-file-from-table #'(lambda (base)
|
||||
(firejail--file-completion-table
|
||||
base 'dironly))
|
||||
index args))
|
||||
|
||||
(defvar-local firejail--relative-to-cache nil
|
||||
"Cache for `firejail--complete-relative-to'.")
|
||||
|
||||
(defmacro firejail--complete-relative-to (dirs &optional no-absolute)
|
||||
"Return a function that completes relative to DIRS.
|
||||
With NO-ABSOLUTE, don't complete absolute file names."
|
||||
(let ((index (make-symbol "index"))
|
||||
(args (make-symbol "args"))
|
||||
(directive (make-symbol "directive"))
|
||||
(out (make-symbol "out"))
|
||||
(idirs (make-symbol "dirs"))
|
||||
(dir (make-symbol "dir"))
|
||||
(adirname (make-symbol "adirname"))
|
||||
(evaled-dirs (eval dirs t)))
|
||||
`(lambda (,index ,args ,directive)
|
||||
(unless firejail--relative-to-cache
|
||||
(setq firejail--relative-to-cache (make-hash-table :test 'equal)))
|
||||
(let ((,idirs (cl-remove-if-not #'file-directory-p
|
||||
(ensure-list ',evaled-dirs)))
|
||||
(,adirname (file-name-directory (cl-third (nth ,index ,args)))))
|
||||
(if-let ((cache (gethash (cons ,adirname ,dirs)
|
||||
firejail--relative-to-cache)))
|
||||
cache
|
||||
(let (,out)
|
||||
(dolist (,dir ,idirs)
|
||||
,(let ((stmt
|
||||
`(let ((default-directory ,dir))
|
||||
(push (firejail--complete-file ,index ,args
|
||||
,directive)
|
||||
,out))))
|
||||
(if no-absolute
|
||||
`(unless (file-name-absolute-p
|
||||
(cl-third (nth ,index ,args)))
|
||||
,stmt)
|
||||
stmt)))
|
||||
(puthash (cons ,adirname ,idirs)
|
||||
(append (seq-take (car ,out) 2)
|
||||
(list (seq-uniq (mapcan 'cl-third ,out))))
|
||||
firejail--relative-to-cache)))))))
|
||||
|
||||
(defmacro firejail--complete-many-from-set (vals)
|
||||
"Return a function to complete a multi-arg directive from VALS."
|
||||
(let ((index (make-symbol "index"))
|
||||
(args (make-symbol "args"))
|
||||
(directive (make-symbol "directive"))
|
||||
(i (make-symbol "i"))
|
||||
(arg (make-symbol "arg"))
|
||||
(present (make-symbol "present"))
|
||||
(evaled-vals (eval vals t)))
|
||||
`(lambda (,index ,args ,directive)
|
||||
(let ((,present (cl-loop for ,i upfrom 0
|
||||
for ,arg in ,args
|
||||
unless (= ,i ,index)
|
||||
collect (cl-third ,arg))))
|
||||
(append (seq-take (nth ,index ,args) 2)
|
||||
(list (seq-difference ,evaled-vals ,present)))))))
|
||||
|
||||
(defun firejail--get-all-env-keys ()
|
||||
"Return the name of every current environment variable."
|
||||
(mapcar (lambda (elt)
|
||||
(if-let ((sep (cl-position ?= elt)))
|
||||
(substring elt 0 sep)
|
||||
elt))
|
||||
process-environment))
|
||||
|
||||
(defun firejail--complete-env (index args _directive)
|
||||
"Complete the arg numbered INDEX in ARGS for an \"env\" directive."
|
||||
(cl-destructuring-bind (start _end text) (nth index args)
|
||||
(let ((sep-pos (or (cl-position ?= text) (length text))))
|
||||
(when (<= (point) (+ start sep-pos))
|
||||
(list start (+ start sep-pos) (firejail--get-all-env-keys))))))
|
||||
|
||||
(defconst firejail-profile--keyword-handlers
|
||||
(let ((ht (make-hash-table :test 'equal)))
|
||||
(cl-flet* ((complete (args fun dirs)
|
||||
(dolist (arg (ensure-list (or args (list nil))))
|
||||
(dolist (dir (ensure-list dirs))
|
||||
(puthash (cons dir arg) fun ht))))
|
||||
(complete-all (fun dirs)
|
||||
(complete nil fun dirs)))
|
||||
(complete 1 #'firejail--complete-include "include")
|
||||
(complete 1 #'firejail--complete-file
|
||||
'("whitelist" "nowhitelist" "blacklist" "noblacklist"
|
||||
"blacklist-nolog" "noexec" "read-only" "read-write"
|
||||
"whitelist-ro" "hosts-file"))
|
||||
(complete 1 #'firejail--complete-directory
|
||||
'("mkdir" "mkfile" "private" "private-cwd" "tmpfs"))
|
||||
(complete '(1 2) #'firejail--complete-file "bind")
|
||||
(complete-all (firejail--complete-relative-to
|
||||
'("/bin" "/sbin" "/usr/bin" "/usr/sbin" "/usr/local/bin")
|
||||
t)
|
||||
"private-bin")
|
||||
(complete-all (firejail--complete-relative-to '(getenv "HOME") t)
|
||||
"private-home")
|
||||
(complete-all (firejail--complete-relative-to "/lib" t)
|
||||
"private-lib")
|
||||
(complete-all (firejail--complete-relative-to "/etc" t)
|
||||
"private-etc")
|
||||
(complete-all (firejail--complete-relative-to "/opt" t)
|
||||
"private-opt")
|
||||
(complete-all (firejail--complete-relative-to "/srv" t)
|
||||
"private-srv")
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
;; evaluate at runtime
|
||||
'firejail--known-caps)
|
||||
"caps.keep")
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
;; evaluate at runtime
|
||||
'(cons "all" firejail--known-caps))
|
||||
"caps.drop")
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
''("unix" "inet" "inet6" "netlink" "packet" "bluetooth"))
|
||||
"protocol")
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
''("cgroup" "ipc" "mnt" "pid" "time" "user" "uts"))
|
||||
"restrict-namespaces")
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
'firejail--known-syscalls64)
|
||||
'("seccomp" "seccomp.drop" "seccomp.keep" ))
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
'firejail--known-syscalls32)
|
||||
'("seccomp.32" "seccomp.32.drop" "seccomp.32.keep"))
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
'(firejail--list-dbus-services :system))
|
||||
'("dbus-system" "dbus-system.own" "dbus-system.talk"
|
||||
"dbus-system.see"))
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
'(firejail--list-dbus-services :session))
|
||||
'("dbus-user" "dbus-user.own" "dbus-user.talk" "dbus-user.see"))
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
'(append '("kill" "log") firejail--known-errnos))
|
||||
"seccomp-error-action")
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
''("none" "xephyr" "xorg" "xpra" "xvfb"))
|
||||
"x11")
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
''("none" "filter"))
|
||||
'("dbus-system" "dbus-user"))
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
''("none" "dhcp"))
|
||||
'("ip" "ip6"))
|
||||
(complete 1 (firejail--complete-many-from-set
|
||||
''("none"))
|
||||
'("net" "shell"))
|
||||
(complete-all (firejail--complete-many-from-set
|
||||
'(mapcar 'number-to-string
|
||||
(number-sequence 0 (firejail--get-num-cpus))))
|
||||
"cpu")
|
||||
(complete 1 #'firejail--complete-env "env"))
|
||||
ht)
|
||||
"Hash table mapping firejail profile directives to their handler.
|
||||
Each handler is a function of three arguments. The first is the index of the
|
||||
current argument, the second is a list of the arguments, the third the
|
||||
directive. These functions mustn't move the point. The point will be on the
|
||||
first character of the argument. The keys of this table are a cons of a
|
||||
directive and its argument number. The values are the completion functions.")
|
||||
|
||||
(defun firejail--quiet-allowed-p ()
|
||||
"Return non-nil if the \"quiet\" directive is allowed on line under point."
|
||||
(save-excursion
|
||||
(let ((orig-line (line-number-at-pos)))
|
||||
(goto-char (point-min))
|
||||
(while (forward-comment 1))
|
||||
(>= (line-number-at-pos) orig-line))))
|
||||
|
||||
(defun firejail--ignored-line-p ()
|
||||
"Return non-nil if the line under point is an \"ignore\" directive.
|
||||
Actually, return the position of the first character of the \"real\" directive."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (looking-at (rx bol (* space) (? "?" (* (any alnum "_")) (? ":"))
|
||||
(+ (* space) "ignore" eow) (or eol (+ space))
|
||||
(group (* nonl)) eol))
|
||||
(match-beginning 1))))
|
||||
|
||||
(defun firejail--read-next-arg ()
|
||||
"Return the bounds of the next argument from the buffer starting at point.
|
||||
This returns a list of four things, the first two are the start and end of the
|
||||
current argument. The third is the text of the argument."
|
||||
(skip-syntax-forward "-")
|
||||
(looking-at (rx (group (* (not (any "\n" "," "#"))))
|
||||
(* space) (or eol "," "#")))
|
||||
(goto-char (match-end 0))
|
||||
(when (eql ?# (char-before))
|
||||
(backward-char))
|
||||
(list (match-beginning 1) (match-end 1)
|
||||
(match-string-no-properties 1)))
|
||||
|
||||
(defun firejail--has-more-args-p ()
|
||||
"Return non-nil if there are probably more args beyond point on this line."
|
||||
(save-excursion
|
||||
(skip-syntax-forward "-")
|
||||
(not (or (eobp) (memql (char-after) '(?\n ?#))))))
|
||||
|
||||
(defun firejail--multi-arg-directive-p (name)
|
||||
"Return non-nil if NAME is a multi-argument directive."
|
||||
(member name '("bind" "private-bin" "private-etc" "private-home"
|
||||
"private-lib" "private-opt" "private-srv" "caps.drop"
|
||||
"caps.keep" "protocol" "restrict-namespaces"
|
||||
"seccomp" "seccomp.32" "seccomp.drop" "seccomp.32.drop"
|
||||
"seccomp.keep" "seccomp.32.keep" "cpu" "iprange")))
|
||||
|
||||
(defun firejail--current-args (dir arg-start)
|
||||
"Return a list of the text of each argument in the directive DIR under point.
|
||||
ARG-START is the first character of the list of arguments."
|
||||
(if (firejail--multi-arg-directive-p dir)
|
||||
(append (save-excursion
|
||||
(goto-char arg-start)
|
||||
(cl-loop while (firejail--has-more-args-p)
|
||||
collect (firejail--read-next-arg)))
|
||||
(list (list (point) (point) "")))
|
||||
(save-excursion
|
||||
(goto-char arg-start)
|
||||
(skip-syntax-forward "-")
|
||||
(let ((eol (pos-eol)))
|
||||
(list (list (point) eol
|
||||
(buffer-substring-no-properties
|
||||
(point) eol)))))))
|
||||
|
||||
(defun firejail--count-args (start end)
|
||||
"Return the number of arguments between START and END."
|
||||
(1+ (how-many "," start end)))
|
||||
|
||||
(defun firejail--complete-arguments (directive arg-start)
|
||||
"Generate completions for the argument that the point is currently in.
|
||||
DIRECTIVE is the directive to generate completions for. ARG-START is the first
|
||||
argument character on the current line."
|
||||
(let* ((cur-arg (if (firejail--multi-arg-directive-p directive)
|
||||
(firejail--count-args arg-start (point))
|
||||
1)))
|
||||
(when-let ((handler (or (gethash (cons directive nil)
|
||||
firejail-profile--keyword-handlers)
|
||||
(gethash (cons directive cur-arg)
|
||||
firejail-profile--keyword-handlers))))
|
||||
(funcall handler (1- cur-arg)
|
||||
(firejail--current-args directive arg-start)
|
||||
directive))))
|
||||
|
||||
(defun firejail--line-conditional-p ()
|
||||
"Return non-nil if the line under point begins with a conditional.
|
||||
Actually, return a list of its bounds and the bounds of its name."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(skip-syntax-forward "-")
|
||||
(when (looking-at (rx (group "?" (group (* (any "_" alnum))) (? ":"))
|
||||
(or eol (+ space) "#")))
|
||||
(list (match-beginning 1) (match-end 1) (match-beginning 2)
|
||||
(match-end 2)))))
|
||||
|
||||
(defun firejail--complete-conditional (start end)
|
||||
"Complete the conditional around point.
|
||||
START and END are the bounds of the name of the conditional."
|
||||
(list start end '()))
|
||||
|
||||
(defun firejail-profile-capf ()
|
||||
"Complete the firejail profile directive at point."
|
||||
(if-let ((word-bounds (bounds-of-thing-at-point 'word)))
|
||||
(cl-loop for kwd in firejail-profile--keyword-list
|
||||
with word-at-point = (buffer-substring-no-properties
|
||||
(car word-bounds)
|
||||
(cdr word-bounds))
|
||||
when (string-prefix-p word-at-point kwd)
|
||||
collect kwd into candidates
|
||||
finally return (list (car word-bounds)
|
||||
(cdr word-bounds)
|
||||
candidates))
|
||||
(list (point)
|
||||
(point)
|
||||
firejail-profile--keyword-list)))
|
||||
"Complete the Firejail profile directive at point."
|
||||
(save-excursion
|
||||
;; don't complete comments
|
||||
(unless (nth 4 (syntax-ppss (point)))
|
||||
(let ((start-pos (point)))
|
||||
(back-to-indentation)
|
||||
(let ((condition (firejail--line-conditional-p))
|
||||
(ignored (firejail--ignored-line-p)))
|
||||
(if (and condition (>= start-pos (cl-first condition))
|
||||
(<= start-pos (cl-second condition)))
|
||||
(list (cl-third condition) (cl-fourth condition)
|
||||
;; is there already a '?'
|
||||
(if (= (cl-second condition) (cl-fourth condition))
|
||||
(mapcar (lambda (elt)
|
||||
(concat elt ":"))
|
||||
firejail--known-conditionals)
|
||||
firejail--known-conditionals))
|
||||
(cond
|
||||
(ignored (goto-char ignored))
|
||||
(condition
|
||||
(goto-char (1+ (cl-second condition)))
|
||||
(skip-syntax-forward "-")))
|
||||
;; read the directive name
|
||||
(looking-at (rx (group (* (not (any space "#" "\n"))))
|
||||
(? (group space))))
|
||||
(let ((directive-start (match-beginning 1))
|
||||
(directive-end (match-end 1))
|
||||
(arg-start (match-end 2)))
|
||||
(if (and arg-start (>= start-pos arg-start))
|
||||
(progn
|
||||
(goto-char start-pos)
|
||||
(firejail--complete-arguments
|
||||
(buffer-substring-no-properties directive-start
|
||||
directive-end)
|
||||
arg-start))
|
||||
(cond
|
||||
((= directive-start directive-end)
|
||||
(setq directive-start start-pos
|
||||
directive-end start-pos))
|
||||
((and (< start-pos directive-start)
|
||||
(eql 2 (syntax-class (syntax-after (1- start-pos)))))
|
||||
(save-excursion
|
||||
(goto-char start-pos)
|
||||
(forward-word -1)
|
||||
(setq directive-start (point)
|
||||
directive-end start-pos)))
|
||||
((< start-pos directive-start)
|
||||
(setq directive-start start-pos
|
||||
directive-end start-pos)))
|
||||
(list
|
||||
directive-start directive-end
|
||||
(append (when (and (not condition) (not ignored)
|
||||
(firejail--quiet-allowed-p))
|
||||
'("quiet"))
|
||||
firejail-profile--keyword-list))))))))))
|
||||
|
||||
(defun firejail--directive-at-point ()
|
||||
"Return the name of the directive at point."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (looking-at (rx bol (* space)
|
||||
(? "?" (* (any alnum "_")) (? ":")
|
||||
(+ space))
|
||||
(* "ignore" (+ space))
|
||||
(group (+ (not (any space "\n" "#"))))))
|
||||
(let ((name (match-string-no-properties 1)))
|
||||
(unless (or (equal name "ignore")
|
||||
(string-prefix-p "?" name)
|
||||
(string-suffix-p ":" name))
|
||||
name)))))
|
||||
|
||||
(defun firejail--read-next-sentence ()
|
||||
"Return from point up to the next sentance end."
|
||||
(let ((start (point))
|
||||
(end (or (re-search-forward (rx eow "." (or " " eol))
|
||||
nil t)
|
||||
(point-max))))
|
||||
(when (eql (char-before end) ? )
|
||||
(cl-decf end)
|
||||
(backward-char))
|
||||
(cl-substitute ? ?\n (buffer-substring-no-properties
|
||||
start end))))
|
||||
|
||||
(defun firejail--format-doc-string-and-get-summary (dir doc)
|
||||
"Format DOC and get a summary for DIR.
|
||||
Return a list of the formatted doc and a summary."
|
||||
(with-temp-buffer
|
||||
(insert doc)
|
||||
(goto-char (point-min))
|
||||
(forward-line)
|
||||
(let ((summary (save-excursion
|
||||
(firejail--read-next-sentence))))
|
||||
(cl-loop for start = (point)
|
||||
until (eobp) do
|
||||
(forward-paragraph)
|
||||
(fill-region-as-paragraph start (point))
|
||||
(forward-line)
|
||||
when (looking-at-p (rx bol (literal dir) (or eol " ")))
|
||||
do (forward-line))
|
||||
(goto-char (point-min))
|
||||
(replace-regexp-in-region (rx (>= 3 "\n")) "\n\n")
|
||||
(replace-regexp-in-region (rx eow "." (+ blank)) ". ")
|
||||
(while (re-search-forward (rx ":" eol) nil t)
|
||||
(forward-line)
|
||||
(while (and (not (eobp))
|
||||
(not (char-uppercase-p (char-after))))
|
||||
(if (= (pos-bol) (pos-eol))
|
||||
(delete-char 1)
|
||||
(insert " ")
|
||||
(forward-line)))
|
||||
(unless (eobp)
|
||||
(insert "\n")))
|
||||
(list (buffer-string) summary))))
|
||||
|
||||
(defun firejail-eldoc-documentation-function (callback &rest _args)
|
||||
"Call CALLBACK with the documentation of the directive under point."
|
||||
(save-excursion
|
||||
(when-let ((name (firejail--directive-at-point))
|
||||
(doc (firejail--documentation-for name)))
|
||||
(cl-destructuring-bind (clean-doc summary)
|
||||
(firejail--format-doc-string-and-get-summary name doc)
|
||||
(funcall callback clean-doc `(:thing ,name
|
||||
:echo ,summary))))))
|
||||
|
||||
(defvar-keymap firejail-profile-mode-map
|
||||
:doc "Keymap for `firejail-profile-mode'."
|
||||
:parent prog-mode-map
|
||||
"C-c C-o" #'ff-find-other-file)
|
||||
|
||||
(define-derived-mode firejail-profile-mode prog-mode "Firejail-Profile"
|
||||
"Major mode for editing firejail profiles."
|
||||
(add-to-list (make-local-variable 'completion-at-point-functions)
|
||||
#'firejail-profile-capf)
|
||||
(setq-local font-lock-defaults '(firejail-profile-font-lock-keywords))
|
||||
(set-syntax-table firejail-profile-syntax-table))
|
||||
:group 'firejail-mode
|
||||
:syntax-table firejail-profile-syntax-table
|
||||
(add-hook 'completion-at-point-functions #'firejail-profile-capf nil t)
|
||||
(setq-local font-lock-defaults '(firejail-profile-font-lock-keywords)
|
||||
comment-start "#"
|
||||
comment-end ""
|
||||
electric-pair-pairs '((?{ . ?}))
|
||||
ff-search-directories firejail-include-search-directories
|
||||
ff-other-file-alist '(("\\.local\\'" (".profile"))
|
||||
("\\.profile\\'" (".local")))
|
||||
eldoc-documentation-functions
|
||||
'(firejail-eldoc-documentation-function
|
||||
t)))
|
||||
|
||||
(add-to-list 'auto-mode-alist
|
||||
'("\\.\\(firejail\\|profile\\|local\\)$" . firejail-profile-mode))
|
||||
'("\\.\\(firejail\\|profile\\|local\\|inc\\)\\'" . firejail-profile-mode))
|
||||
|
||||
(provide 'firejail-mode)
|
||||
;;; firejail-mode.el ends here
|
||||
|
||||
;; Local Variables:
|
||||
;; jinx-local-words: "Firejail Firejail's"
|
||||
;; End:
|
||||
|
499
elisp/inferior-cc.el
Normal file
499
elisp/inferior-cc.el
Normal file
@ -0,0 +1,499 @@
|
||||
;;; inferior-cc.el --- Run interpreters for cc-mode languages -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
(require 'comint)
|
||||
(require 'cl-lib)
|
||||
(require 'cc-mode)
|
||||
(require 'treesit)
|
||||
(require 'shell)
|
||||
(eval-when-compile (require 'rx))
|
||||
|
||||
(defgroup inferior-cc ()
|
||||
"Run interpreters for `cc-mode' languages."
|
||||
:group 'comint)
|
||||
|
||||
(defclass inferior-cc-interpreter ()
|
||||
((name :type string
|
||||
:initarg :name
|
||||
:accessor inf-cc-name
|
||||
:doc "The name of this interpreter.")
|
||||
(command :type string
|
||||
:initarg :command
|
||||
:accessor inf-cc-command
|
||||
:doc "The command (program) for this interpreter.")
|
||||
(args :type (list-of string)
|
||||
:initarg :args
|
||||
:accessor inf-cc-args
|
||||
:initform nil
|
||||
:doc "Command-line arguments to pass to the interpreter.")
|
||||
(font-lock-mode :type (or null function)
|
||||
:initarg :font-lock-mode
|
||||
:accessor inf-cc-font-lock-mode
|
||||
:initform nil
|
||||
:doc "Major mode to use for font locking of the interpreter's
|
||||
input. A value of nil means don't do font locking.")
|
||||
(modes :type (list-of function)
|
||||
:initarg :modes
|
||||
:accessor inf-cc-modes
|
||||
:initform nil
|
||||
:doc "The major modes that this interpreter corresponds to.")
|
||||
(exp-at-point-func :type (or function null)
|
||||
:initarg :exp-at-point-func
|
||||
:accessor inf-cc-exp-at-point-func
|
||||
:initform nil
|
||||
:doc "Function to retrieve the expression at point for
|
||||
languages supported by this interpreter."))
|
||||
(:documentation "An interpreter for a `cc-mode'-like language."))
|
||||
|
||||
(define-widget 'inferior-cc-interpreter 'lazy
|
||||
"Interpreter for `cc-mode'-like languages."
|
||||
:offset 4
|
||||
:tag "Interpreter"
|
||||
:type '(list (string :tag "Name")
|
||||
(repeat :tag "Command line" (string :tag "Argument"))
|
||||
(choice :tag "Font lock mode"
|
||||
(function :tag "Major mode")
|
||||
(const :tag "None" nil))
|
||||
(repeat :tag "Major modes" (function :tag "Major mode"))
|
||||
(choice :tag "Expression at point function"
|
||||
(function :tag "Function")
|
||||
(const :tag "None" nil))))
|
||||
|
||||
(defun inf-cc--interpreter-list-to-obj (list)
|
||||
"Return LIST as a proper `inferior-cc-interpreter' object."
|
||||
(cl-destructuring-bind (name (command &rest args) font-lock-mode modes
|
||||
exp-at-point-func)
|
||||
list
|
||||
(inferior-cc-interpreter :name name :command command
|
||||
:args args :font-lock-mode font-lock-mode
|
||||
:modes modes :exp-at-point-func exp-at-point-func)))
|
||||
|
||||
(defun inf-cc--interpreter-obj-to-list (obj)
|
||||
"Return OBJ, a proper `inferior-cc-interpreter', object as a list."
|
||||
(with-slots (name command args font-lock-mode modes exp-at-point-func) obj
|
||||
(list name (cons command args) font-lock-mode modes exp-at-point-func)))
|
||||
|
||||
(defun inf-cc--remove-trailing-semicolon (str)
|
||||
"Remove a trailing semicolon and whitespace from STR."
|
||||
(if (string-match (rx (* (syntax whitespace))
|
||||
";"
|
||||
(* (syntax whitespace)) eos)
|
||||
str)
|
||||
(substring str 0 (match-beginning 0))
|
||||
str))
|
||||
|
||||
(defun inf-cc--remove-surrounding-parens (str)
|
||||
"Remove surrounding parenthesis from STR."
|
||||
(if (string-match (rx bos (* (syntax whitespace)) "("
|
||||
(group (* any))
|
||||
")" (* (syntax whitespace)) eos)
|
||||
str)
|
||||
(match-string 1 str)
|
||||
str))
|
||||
|
||||
(defun inf-cc--c-c++-ts-exp-at-point ()
|
||||
"Return the expression at point in `c-ts-mode' and `c++-ts-mode' buffers."
|
||||
(unless (or (derived-mode-p 'c-ts-mode 'c++-ts-mode))
|
||||
(user-error "Major mode does not support find expressions: %s" major-mode))
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(when-let ((thing (treesit-thing-at-point "_" 'nested)))
|
||||
(inf-cc--remove-trailing-semicolon (treesit-node-text thing)))))
|
||||
|
||||
(defun inf-cc--java-ts-exp-at-point ()
|
||||
"Return the expression at point in `java-ts-mode' buffers."
|
||||
(unless (or (derived-mode-p 'java-ts-mode))
|
||||
(user-error "Major mode does not support find expressions: %s" major-mode))
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(let ((root (treesit-buffer-root-node)))
|
||||
(let ((node (car (or (treesit-query-range
|
||||
root '([(expression_statement)
|
||||
(field_declaration)
|
||||
(local_variable_declaration)
|
||||
(import_declaration)]
|
||||
@exp)
|
||||
(point) (1+ (point)))
|
||||
(treesit-query-range
|
||||
root '([(parenthesized_expression)
|
||||
(binary_expression)
|
||||
(update_expression)
|
||||
(unary_expression)]
|
||||
@exp)
|
||||
(point) (1+ (point)))))))
|
||||
(inf-cc--remove-surrounding-parens
|
||||
(inf-cc--remove-trailing-semicolon
|
||||
(buffer-substring-no-properties (car node) (cdr node))))))))
|
||||
|
||||
(defcustom inferior-cc-interpreters
|
||||
(list (inferior-cc-interpreter :name "jshell"
|
||||
:command "jshell"
|
||||
:font-lock-mode 'java-mode
|
||||
:modes '(java-mode java-ts-mode)
|
||||
:exp-at-point-func
|
||||
'inf-cc--java-ts-exp-at-point)
|
||||
(inferior-cc-interpreter :name "root"
|
||||
:command "root"
|
||||
:font-lock-mode 'c++-mode
|
||||
:modes '(c-mode c-ts-mode c++-mode c++-ts-mode)
|
||||
:exp-at-point-func
|
||||
'inf-cc--c-c++-ts-exp-at-point))
|
||||
"List of inferior-cc interpreters."
|
||||
:type '(repeat inferior-cc-interpreter)
|
||||
:get (lambda (sym)
|
||||
(mapcar 'inf-cc--interpreter-obj-to-list (default-toplevel-value sym)))
|
||||
:set (lambda (sym newval)
|
||||
(set-default-toplevel-value
|
||||
sym (mapcar #'(lambda (elt)
|
||||
(if (inferior-cc-interpreter-p elt)
|
||||
elt
|
||||
(inf-cc--interpreter-list-to-obj elt)))
|
||||
newval)))
|
||||
:group 'inferior-cc)
|
||||
|
||||
(defvar-local inf-cc--obj nil
|
||||
"The current buffer's interpreter object.")
|
||||
(put 'inf-cc--obj 'permanent-local t)
|
||||
|
||||
(defvar-local inf-cc--fontification-buffer nil
|
||||
"The fontification buffer for the current buffer.")
|
||||
|
||||
(defvar-local inf-cc--skip-next-lines 0
|
||||
"Number of lines of output to skip.")
|
||||
|
||||
(defun inf-cc--preoutput-filter-function (output)
|
||||
"Preoutput filter function for inferior cc buffers.
|
||||
OUTPUT is the new text to be inserted."
|
||||
(if (<= inf-cc--skip-next-lines 0)
|
||||
output
|
||||
(let* ((lines (string-lines output))
|
||||
(cnt (length lines)))
|
||||
(if (> cnt inf-cc--skip-next-lines)
|
||||
(prog1
|
||||
(string-join (nthcdr inf-cc--skip-next-lines lines) "\n")
|
||||
(setq inf-cc--skip-next-lines 0))
|
||||
(cl-decf inf-cc--skip-next-lines cnt)
|
||||
(when (and (not (string-empty-p output))
|
||||
(/= ?\n (elt output (1- (length output)))))
|
||||
(cl-incf inf-cc--skip-next-lines))
|
||||
""))))
|
||||
|
||||
(defun inf-cc--get-fontification-buffer ()
|
||||
"Return or create the current buffer's fontification buffer."
|
||||
(if (buffer-live-p inf-cc--fontification-buffer)
|
||||
inf-cc--fontification-buffer
|
||||
(let ((buffer (generate-new-buffer
|
||||
(format " %s-fontification-buffer" (buffer-name))))
|
||||
(obj inf-cc--obj))
|
||||
(with-current-buffer buffer
|
||||
(setq-local inf-cc--obj obj)
|
||||
(unless (and (inf-cc-font-lock-mode inf-cc--obj)
|
||||
(derived-mode-p (inf-cc-font-lock-mode inf-cc--obj)))
|
||||
(let ((delayed-mode-hooks nil))
|
||||
(delay-mode-hooks
|
||||
(funcall (inf-cc-font-lock-mode inf-cc--obj)))))
|
||||
(when (eq c-basic-offset 'set-from-style)
|
||||
(setq-local c-basic-offset standard-indent))
|
||||
(let ((inhibit-message t))
|
||||
(indent-tabs-mode -1))
|
||||
(unless font-lock-mode
|
||||
(font-lock-mode 1)))
|
||||
(setq-local inf-cc--fontification-buffer buffer))))
|
||||
|
||||
(defmacro inf-cc--with-font-lock-buffer (&rest body)
|
||||
"Execute BODY in the current buffer's fortification buffer.
|
||||
Note that this erases the buffer before doing anything."
|
||||
`(with-current-buffer (inf-cc--get-fontification-buffer)
|
||||
(erase-buffer)
|
||||
,@body))
|
||||
|
||||
(defun inf-cc--fontify-current-input ()
|
||||
"Function called from `post-command-hook' to fontify the current input."
|
||||
(when-let (((inf-cc-font-lock-mode inf-cc--obj))
|
||||
(proc (get-buffer-process (current-buffer)))
|
||||
(start (process-mark proc))
|
||||
(end (point-max))
|
||||
(input (buffer-substring-no-properties start end))
|
||||
(fontified (inf-cc--with-font-lock-buffer
|
||||
(insert input)
|
||||
(font-lock-ensure)
|
||||
(buffer-string)))
|
||||
(len (length fontified))
|
||||
(i 0))
|
||||
;; mostly from:
|
||||
;; `python-shell-font-lock-post-command-hook'
|
||||
(while (not (= i len))
|
||||
(let* ((props (text-properties-at i fontified))
|
||||
(change-i (or (next-property-change i fontified)
|
||||
len)))
|
||||
(when-let ((face (plist-get props 'face)))
|
||||
(setf (plist-get props 'face) nil
|
||||
(plist-get props 'font-lock-face) face))
|
||||
(set-text-properties (+ start i) (+ start change-i) props)
|
||||
(setq i change-i)))))
|
||||
|
||||
(defun inf-cc--bounds-of-last-prompt ()
|
||||
"Return the bounds of the last prompt.
|
||||
This returns a cons."
|
||||
(save-excursion
|
||||
(let ((end (process-mark (get-buffer-process (current-buffer)))))
|
||||
(goto-char end)
|
||||
(cons (pos-bol) end))))
|
||||
|
||||
(defun inf-cc--remove-extra-indentation (count)
|
||||
"Remove COUNT spaces from the start of each line."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(back-to-indentation)
|
||||
(let ((indent (- (point) (pos-bol))))
|
||||
(when (> indent count)
|
||||
(delete-char (- count))))
|
||||
(forward-line))))
|
||||
|
||||
(defun inf-cc--indent-line-function ()
|
||||
"`indent-line-function' for inferior cc comint buffers."
|
||||
(when (inf-cc-font-lock-mode inf-cc--obj)
|
||||
(let* ((start (process-mark (get-buffer-process (current-buffer)))))
|
||||
;; don't indent the first line
|
||||
(unless (= (pos-bol) (save-excursion (goto-char start) (pos-bol)))
|
||||
(let* ((input (buffer-substring-no-properties start (pos-eol)))
|
||||
(prompt-size (let ((bound (inf-cc--bounds-of-last-prompt)))
|
||||
(- (cdr bound) (car bound))))
|
||||
(col (inf-cc--with-font-lock-buffer
|
||||
(insert input)
|
||||
(inf-cc--remove-extra-indentation prompt-size)
|
||||
(c-indent-line nil t)
|
||||
(back-to-indentation)
|
||||
(- (point) (pos-bol)))))
|
||||
(save-excursion
|
||||
(indent-line-to (+ prompt-size col)))
|
||||
(skip-syntax-forward "-"))))))
|
||||
|
||||
(defun inferior-cc-send-input ()
|
||||
"Like `comint-send-input', but with some extra stuff for inferior cc."
|
||||
(interactive)
|
||||
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
|
||||
(end (if comint-eol-on-send (pos-eol) (point))))
|
||||
(with-restriction pmark end
|
||||
(let ((res (syntax-ppss (point-max))))
|
||||
(without-restriction
|
||||
(cond
|
||||
;; open string
|
||||
((cl-fourth res)
|
||||
(message "Unterminated string"))
|
||||
;; unmatched blocks or comment
|
||||
((or (numberp (cl-fifth res))
|
||||
(not (zerop (cl-first res)))
|
||||
;; trailing . character
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(skip-syntax-backward "-")
|
||||
(eql (char-before) ?.)))
|
||||
(newline-and-indent))
|
||||
(t
|
||||
;; ignore the interpreter echoing back our lines
|
||||
(setq-local inf-cc--skip-next-lines (count-lines pmark end))
|
||||
(when (= pmark end)
|
||||
(cl-incf inf-cc--skip-next-lines))
|
||||
;; also, methods add a bunch of extra newlines
|
||||
(when (>= inf-cc--skip-next-lines 2)
|
||||
(cl-incf inf-cc--skip-next-lines (- inf-cc--skip-next-lines 2)))
|
||||
(comint-send-input))))))))
|
||||
|
||||
(defvar-keymap inferior-cc-shell-mode-map
|
||||
:doc "Keymap for `inferior-cc-shell-mode'."
|
||||
:parent comint-mode-map
|
||||
"RET" #'inferior-cc-send-input)
|
||||
|
||||
(defun inf-cc--kill-fontification-buffer ()
|
||||
"Kill the current `inf-cc--fontification-buffer'."
|
||||
(ignore-errors
|
||||
(kill-buffer inf-cc--fontification-buffer)))
|
||||
|
||||
(define-derived-mode inferior-cc-shell-mode comint-mode ""
|
||||
"Major mode for buffers running inferior cc interpreters.
|
||||
You MUST set `inf-cc--obj' before activating this major mode."
|
||||
:interactive nil
|
||||
:group 'inferior-jshell
|
||||
:syntax-table nil
|
||||
(with-slots (name font-lock-mode) inf-cc--obj
|
||||
(setq-local comint-highlight-input nil
|
||||
indent-line-function #'inf-cc--indent-line-function
|
||||
electric-indent-chars '(?\n ?})
|
||||
mode-name (concat "Inferior " (upcase-initials name)))
|
||||
(when-let ((font-lock-mode)
|
||||
(sym (intern-soft (format "%s-syntax-table" font-lock-mode)))
|
||||
(syntax-table (symbol-value sym)))
|
||||
(set-syntax-table syntax-table)))
|
||||
(add-hook 'comint-preoutput-filter-functions
|
||||
#'inf-cc--preoutput-filter-function
|
||||
nil t)
|
||||
(add-hook 'post-command-hook
|
||||
#'inf-cc--fontify-current-input
|
||||
nil t)
|
||||
(add-hook 'kill-buffer-hook
|
||||
#'inf-cc--kill-fontification-buffer
|
||||
nil t))
|
||||
|
||||
(cl-defun inf-cc--find-buffer ()
|
||||
"Find and return a live inferior cc buffer for the current major mode."
|
||||
(let ((target-mode major-mode))
|
||||
(dolist (buffer (buffer-list))
|
||||
(with-current-buffer buffer
|
||||
(when (and (process-live-p (get-buffer-process buffer))
|
||||
inf-cc--obj
|
||||
(member target-mode (inf-cc-modes inf-cc--obj)))
|
||||
(cl-return-from inf-cc--find-buffer buffer))))))
|
||||
|
||||
(defun inferior-cc-eval (code)
|
||||
"Evaluate CODE in a live inferior cc buffer."
|
||||
(interactive "sEval: " inferior-cc-shell-mode)
|
||||
(let ((buffer (inf-cc--find-buffer)))
|
||||
(unless buffer
|
||||
(user-error "No live inferior cc buffer found"))
|
||||
(with-current-buffer buffer
|
||||
(let* ((start (process-mark (get-buffer-process buffer)))
|
||||
(end (point-max))
|
||||
(old (buffer-substring-no-properties start end)))
|
||||
(delete-region start end)
|
||||
(goto-char (point-max))
|
||||
(insert code)
|
||||
(goto-char (point-max))
|
||||
;; don't save history
|
||||
(let ((comint-input-filter #'ignore))
|
||||
(inferior-cc-send-input))
|
||||
(goto-char (point-max))
|
||||
(insert old)
|
||||
(goto-char (point-max))))))
|
||||
|
||||
(defun inferior-cc-eval-region (start end)
|
||||
"Evaluate the current buffer from START to END in a live inferior cc buffer.
|
||||
START and END default to the current region."
|
||||
(interactive "r" inferior-cc-shell-mode)
|
||||
(inferior-cc-eval (buffer-substring-no-properties start end))
|
||||
(message "Evaluated %s lines" (count-lines start end)))
|
||||
|
||||
(defun inferior-cc-eval-buffer ()
|
||||
"Send the current buffer to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(inferior-cc-eval-region (point-min) (point-max))
|
||||
(message "Evaluated buffer %s" (current-buffer)))
|
||||
|
||||
(defun inferior-cc-eval-defun ()
|
||||
"Send the defun under point to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(let ((bounds (bounds-of-thing-at-point 'defun)))
|
||||
(unless bounds
|
||||
(user-error "No defun under point"))
|
||||
(inferior-cc-eval-region (car bounds) (cdr bounds))
|
||||
(message "Evaluated defun (%s lines)" (count-lines (car bounds)
|
||||
(cdr bounds)))))
|
||||
|
||||
(defun inferior-cc-eval-line ()
|
||||
"Send the line under point to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(inferior-cc-eval-region (pos-bol) (pos-eol))
|
||||
(message "Evaluated %s" (buffer-substring (pos-bol) (pos-eol))))
|
||||
|
||||
(defun inferior-cc-eval-expression ()
|
||||
"Evaluate the expression under point in a live inferior cc buffer.
|
||||
This only works in modes that have defined an \\=:exp-at-point-func."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(let ((obj (inf-cc--find-interpreter-for-mode)))
|
||||
(unless obj
|
||||
(user-error "Cannot get expression for major mode: %s" major-mode))
|
||||
(with-slots ((func exp-at-point-func)) obj
|
||||
(unless func
|
||||
(user-error "Cannot get expression for major mode: %s" major-mode))
|
||||
(let ((code (funcall func)))
|
||||
(unless code
|
||||
(user-error "No expression under point"))
|
||||
(inferior-cc-eval code)
|
||||
(message "Evaluated expression (%s lines)"
|
||||
(1+ (cl-count ?\n code)))))))
|
||||
|
||||
(defun inf-cc--find-interpreter-for-mode (&optional mode)
|
||||
"Find a suitable interpreter for MODE, defaulting to `major-mode'."
|
||||
(unless mode (setq mode major-mode))
|
||||
(cl-find-if (lambda (elt)
|
||||
(with-slots (modes) elt
|
||||
(member mode modes)))
|
||||
inferior-cc-interpreters))
|
||||
|
||||
(defun inf-cc--interpreter-by-name (name)
|
||||
"Find the interpreter named NAME."
|
||||
(cl-find-if (lambda (elt)
|
||||
(equal (inf-cc-name elt) name))
|
||||
inferior-cc-interpreters))
|
||||
|
||||
(defun inf-cc--prompt-for-interpreter ()
|
||||
"Prompt for an inferior cc interpreter."
|
||||
(inf-cc--interpreter-by-name
|
||||
(completing-read "Interpreter: "
|
||||
(mapcar 'inf-cc-name inferior-cc-interpreters) nil t)))
|
||||
|
||||
(defun inf-cc--prompt-for-command (int)
|
||||
"Prompt for a command line for INT."
|
||||
(with-slots (command args) int
|
||||
(let* ((def-cmd (string-join (mapcar 'shell-quote-argument
|
||||
(cons command args))
|
||||
" "))
|
||||
(choice (read-shell-command "Command: " def-cmd)))
|
||||
(split-string-shell-command choice))))
|
||||
|
||||
(defun run-cc-interpreter (int &optional command)
|
||||
"Run the `cc-mode'-like interpreter INT.
|
||||
Interactively, INT will be an interpreter suitable for the current
|
||||
`major-mode'. With a prefix argument, prompt for an interpreter.
|
||||
|
||||
If COMMAND is non-nil, it should be a list with the first element being the
|
||||
program to execute and the rest of the elements being the arguments to pass to
|
||||
the interpreter. This overrides the default settings in INT. Interactively,
|
||||
prompt for COMMAND with two prefix arguments."
|
||||
(interactive (let ((int (if current-prefix-arg
|
||||
(inf-cc--prompt-for-interpreter)
|
||||
(or (inf-cc--find-interpreter-for-mode)
|
||||
(inf-cc--prompt-for-interpreter)))))
|
||||
(list int
|
||||
(when (>= (prefix-numeric-value current-prefix-arg) 16)
|
||||
(inf-cc--prompt-for-command int)))))
|
||||
(with-slots (name (def-cmd command) args) int
|
||||
(unless command
|
||||
(setq command (cons def-cmd args)))
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create (format "*%s*" name))
|
||||
(prog1 (current-buffer)
|
||||
(unless (process-live-p (get-buffer-process (current-buffer)))
|
||||
(setq-local inf-cc--obj int)
|
||||
(inferior-cc-shell-mode)
|
||||
(comint-exec (current-buffer)
|
||||
(format "Inferior %s" (upcase-initials name))
|
||||
(car command) nil (cdr command))))))))
|
||||
|
||||
(defun run-jshell (command)
|
||||
"Run JShell in a comint buffer.
|
||||
COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
|
||||
causes the user to be prompted."
|
||||
(interactive (list (when current-prefix-arg
|
||||
(inf-cc--prompt-for-command
|
||||
(inf-cc--interpreter-by-name "jshell")))))
|
||||
(run-cc-interpreter (inf-cc--interpreter-by-name "jshell") command))
|
||||
|
||||
(defun run-root (command)
|
||||
"Run CERN root in a comint buffer.
|
||||
COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
|
||||
causes the user to be prompted."
|
||||
(interactive (list (when current-prefix-arg
|
||||
(inf-cc--prompt-for-command
|
||||
(inf-cc--interpreter-by-name "root")))))
|
||||
(run-cc-interpreter (inf-cc--interpreter-by-name "root") command))
|
||||
|
||||
(provide 'inferior-cc)
|
||||
;;; inferior-cc.el ends here
|
182
elisp/khard.el
182
elisp/khard.el
@ -1,42 +1,38 @@
|
||||
;;; khard.el --- Emacs integration with khard
|
||||
;;; khard.el --- Emacs integration with khard -*- lexical-binding: t -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(require 'with-editor)
|
||||
(require 'cl-lib)
|
||||
(require 'message)
|
||||
|
||||
(add-to-list 'display-buffer-alist '(" \\*khard output\\*" . (display-buffer-no-window)))
|
||||
(defcustom khard-executable "khard"
|
||||
"The executable to use to run khard."
|
||||
:group 'khard
|
||||
:type 'string)
|
||||
|
||||
(defvar-local khard--contacts-cache ()
|
||||
"List of contacts used while completing at point.
|
||||
This exists so that Emacs doesn't slow down while running
|
||||
`completion-at-point-functions'. This is local to each buffer.")
|
||||
|
||||
(defun khard--build-list-entry-detail (&rest items)
|
||||
"Build a detail in the format \" (ITEMS)\", or an empty string."
|
||||
(let ((clean-items (remove "" items)))
|
||||
(if (not (seq-empty-p clean-items))
|
||||
(format " (%s)"
|
||||
(string-join clean-items ", "))
|
||||
(if clean-items
|
||||
(format " (%s)" (string-join clean-items ", "))
|
||||
"")))
|
||||
|
||||
(defun khard--remove-leading-label (field)
|
||||
"Remove a leading \"name: \" from FIELD."
|
||||
(if-let (index (string-search ":" field))
|
||||
(substring field (+ index 2))
|
||||
field))
|
||||
|
||||
(defun khard--build-uid-email-phone-list ()
|
||||
"Build a list in the format (info . uid)."
|
||||
(let ((lines (process-lines "khard"
|
||||
"ls"
|
||||
"--parsable"
|
||||
"--fields=uid,name,email,phone")))
|
||||
(mapcar (lambda (line)
|
||||
(let* ((fields (split-string line "\t"))
|
||||
(uid (car fields))
|
||||
(name (cadr fields))
|
||||
(email (khard--remove-leading-label (caddr fields)))
|
||||
(phone (khard--remove-leading-label (cadddr fields))))
|
||||
(cons (format "%s%s"
|
||||
name
|
||||
(khard--build-list-entry-detail email phone uid))
|
||||
uid)))
|
||||
lines)))
|
||||
(cl-loop for line in
|
||||
(process-lines "khard" "ls"
|
||||
"--parsable" "--fields=uid,name,email,phone")
|
||||
for (uid name email phone) = (split-string line "\t")
|
||||
collect
|
||||
(cons (format "%s%s" name
|
||||
(khard--build-list-entry-detail email phone uid))
|
||||
uid)))
|
||||
|
||||
(defun khard--prompt-contact (&optional prompt)
|
||||
"Prompt user for a contact, optionally make the prompt text PROMPT."
|
||||
@ -48,69 +44,69 @@
|
||||
"Process sentinel for kahrd commands.
|
||||
For info on PROC and STATUS, see `set-process-sentinel'."
|
||||
(when (memq (process-status proc) '(exit signal))
|
||||
(shell-command-set-point-after-cmd (process-buffer proc))
|
||||
(message "khard: %s." (substring status 0 -1))))
|
||||
|
||||
(cl-defun khard--run-khard (args &key filter)
|
||||
"Run khard with ARGS.
|
||||
FILTER is a process filter to install on the child process."
|
||||
(let ((process-environment process-environment))
|
||||
(setenv "EDITOR" with-editor-sleeping-editor)
|
||||
(make-process
|
||||
:name (concat "khard" (car args))
|
||||
:command (apply 'list khard-executable args)
|
||||
:buffer nil
|
||||
:filter filter
|
||||
:sentinel 'khard--process-sentinel)))
|
||||
|
||||
(defun khard-delete (contact no-confirm)
|
||||
"Delete CONTACT, which is of the form (name . uid).
|
||||
When called interactively, prompt the user.
|
||||
If NO-CONFIRM is nil, do not ask the user."
|
||||
(interactive (list (khard--prompt-contact "Delete Contact ") nil))
|
||||
(when (or no-confirm (yes-or-no-p (format "Really delete \"%s\"? "
|
||||
(car-safe contact))))
|
||||
(make-process :name "khard delete"
|
||||
:command
|
||||
`("khard" "delete" "--force"
|
||||
,(format "uid:%s" (cdr-safe contact)))
|
||||
:buffer " *khard output*"
|
||||
:sentinel #'khard--process-sentinel)))
|
||||
(car contact))))
|
||||
(khard--run-khard (list "delete" "--force"
|
||||
(format "uid:%s" (cdr contact))))))
|
||||
|
||||
(defun khard--prompt-address-book ()
|
||||
"Prompt for an address book."
|
||||
(completing-read "Address Book " (process-lines "khard" "abooks")))
|
||||
|
||||
(defun khard--new-process-filter (proc str)
|
||||
"Process filter for `khard-new'.
|
||||
"Process filter for `khard-new' and `khard-edit'.
|
||||
PROC and STR are described in `set-process-filter'."
|
||||
(let ((lines (string-split str "\n"))
|
||||
(error-msg nil))
|
||||
(errors nil))
|
||||
(dolist (line lines)
|
||||
(if (equal
|
||||
"Do you want to open the editor again? (y/N) "
|
||||
line)
|
||||
(if (y-or-n-p (format "%sReopen the editor? "
|
||||
(or error-msg
|
||||
"Unknown error")))
|
||||
(process-send-string proc "y\n")
|
||||
(process-send-string proc "n\n"))
|
||||
(setq error-msg (concat error-msg "\n" line)))))
|
||||
(cond
|
||||
((string-prefix-p "Do you want to open the editor again? " line)
|
||||
(if (y-or-n-p (format "%sReopen the editor? "
|
||||
(cond
|
||||
((null errors)
|
||||
"")
|
||||
((length= errors 1)
|
||||
(concat (cl-first errors) ". "))
|
||||
(t
|
||||
(concat (string-join errors "\n") "\n")))))
|
||||
(process-send-string proc "y\n")
|
||||
(process-send-string proc "n\n")))
|
||||
((string-match (rx bos "Error: " (group (+ any)) eol) line)
|
||||
(push (match-string 1 line) errors)))))
|
||||
(with-editor-process-filter proc str t))
|
||||
|
||||
(defun khard-new (abook)
|
||||
"Create a new card and open it in an new buffer to edit.
|
||||
When called interactively, prompt for ABOOK."
|
||||
(interactive (list (khard--prompt-address-book)))
|
||||
(when abook
|
||||
(let ((error-msg nil))
|
||||
(make-process :name "khard new"
|
||||
:command
|
||||
`("env" ,(concat "EDITOR=" with-editor-sleeping-editor)
|
||||
"khard" "new" "--edit" "-a" ,abook)
|
||||
:buffer " *khard output*"
|
||||
:filter #'khard--new-process-filter
|
||||
:sentinel #'khard--process-sentinel))))
|
||||
(khard--run-khard (list "new" "--edit" "-a" abook)
|
||||
:filter 'khard--new-process-filter))
|
||||
|
||||
(defun khard-edit (uid)
|
||||
"Edit the contact with UID.
|
||||
When called interactively, prompt the user."
|
||||
(interactive (list (cdr-safe (khard--prompt-contact "Edit Contact "))))
|
||||
(make-process :name "khard edit"
|
||||
:command
|
||||
`("env" ,(concat "EDITOR=" with-editor-sleeping-editor)
|
||||
"khard" "edit" "--edit" ,(format "uid:%s" uid))
|
||||
:buffer " *khard output*"
|
||||
:filter #'khard--new-process-filter
|
||||
:sentinel #'khard--process-sentinel))
|
||||
(khard--run-khard (list "edit" "--edit" (format "uid:%s" uid))
|
||||
:filter 'khard--new-process-filter))
|
||||
|
||||
(defun khard--parse-email-list (list-str)
|
||||
"Parse LIST-STR, a python dictionary and array string of emails."
|
||||
@ -133,7 +129,7 @@ When called interactively, prompt the user."
|
||||
((= char ?\\)
|
||||
(setq backslash t))
|
||||
((= char ?')
|
||||
(add-to-list 'output cur-str)
|
||||
(push cur-str output)
|
||||
(setq cur-str ""
|
||||
in-quote nil))
|
||||
(t
|
||||
@ -148,27 +144,65 @@ When called interactively, prompt the user."
|
||||
|
||||
(defun khard--make-email-contacts-list ()
|
||||
"Make a list of email contacts from khard."
|
||||
(let ((lines (process-lines "khard"
|
||||
"ls"
|
||||
"--parsable"
|
||||
"--fields=name,emails"))
|
||||
(let ((lines (process-lines "khard" "ls"
|
||||
"--parsable" "--fields=name,emails"))
|
||||
(output nil))
|
||||
(dolist (line lines)
|
||||
(let* ((fields (split-string line "\t"))
|
||||
(name (car fields))
|
||||
(email-list (cadr fields)))
|
||||
(cl-destructuring-bind (name email-list)
|
||||
(split-string line "\t")
|
||||
(dolist (email (khard--parse-email-list email-list))
|
||||
(add-to-list 'output (format "%s <%s>"
|
||||
name
|
||||
email)))))
|
||||
output))
|
||||
(push (format "%s <%s>"
|
||||
name
|
||||
email)
|
||||
output))))
|
||||
(seq-uniq output)))
|
||||
|
||||
(defun khard--contacts-cache (&optional force)
|
||||
"Return the contacts cache, building it if nessesary.
|
||||
With FORCE, rebuild the cache no matter what."
|
||||
(when (or force (not khard--contacts-cache))
|
||||
(setq-local khard--contacts-cache (khard--make-email-contacts-list)))
|
||||
khard--contacts-cache)
|
||||
|
||||
(defun khard-insert-email-contact ()
|
||||
"Use `completing-read' to prompt for and insert a khard contact."
|
||||
(interactive)
|
||||
(if-let (contact (completing-read "Insert Contact "
|
||||
(khard--make-email-contacts-list)))
|
||||
(khard--contacts-cache t)))
|
||||
(insert contact)))
|
||||
|
||||
(defun khard--message-in-header-p (name &optional testfn)
|
||||
"If in field NAME, return the start of the header, otherwise, return nil.
|
||||
The name is compared with the field name using TESTFN (defaults to `equal')."
|
||||
(save-excursion
|
||||
(when (and (message-point-in-header-p)
|
||||
(message-beginning-of-header t))
|
||||
(beginning-of-line)
|
||||
(when (and (looking-at (rx bol (group (+? any)) ":" (? " ")))
|
||||
(funcall (or testfn 'equal) (match-string 1) name))
|
||||
(match-end 0)))))
|
||||
|
||||
(defun khard-message-mode-capf ()
|
||||
"Completion at point function for khard contacts in message mode."
|
||||
(interactive)
|
||||
(when-let ((field-start (khard--message-in-header-p "To")))
|
||||
(save-excursion
|
||||
(let ((end (point)))
|
||||
(re-search-backward (rx (any "\n" "," ":") (* whitespace))
|
||||
field-start t)
|
||||
(list (match-end 0) end (khard--contacts-cache))))))
|
||||
|
||||
(defun khard-refresh-contact-cache (all-buffers &optional no-refresh)
|
||||
"Refresh the khard contact cache.
|
||||
When ALL-BUFFERS is non-nil, as it is with a prefix argument, refresh the cache
|
||||
of all buffers. With NO-REFRESH, don't refresh the cache, just clear it."
|
||||
(interactive "P")
|
||||
(let ((new-cache (and (not no-refresh) (khard--make-email-contacts-list))))
|
||||
(if all-buffers
|
||||
(cl-loop for buf being the buffers do
|
||||
(setf (buffer-local-value 'khard--contacts-cache buf)
|
||||
new-cache))
|
||||
(setq-local khard--contacts-cache new-cache))))
|
||||
|
||||
(provide 'khard)
|
||||
;;; khard.el ends here
|
||||
|
681
elisp/latex-help.el
Normal file
681
elisp/latex-help.el
Normal file
@ -0,0 +1,681 @@
|
||||
;;; latex-help.el --- Lookup LaTeX symbols -*- lexical-binding: t -*-
|
||||
|
||||
;;; Commentary:
|
||||
;; This is inspired by an old package (originally from the 90s!!) called
|
||||
;; ltx-help.el. That package used to be called latex-help.el too, but it seems
|
||||
;; to have had its name changed sometime around 2010. This package aims for
|
||||
;; similar functionality, but using more up to date and convention-conforming
|
||||
;; Elisp. For example, the original package still assumes that you may not have
|
||||
;; `add-hook' or `buffer-substring-no-properties'. Only very old versions of
|
||||
;; Emacs are missing these, so almost everyone has them nowadays.
|
||||
;;
|
||||
;; This file is mostly internal functions. People looking to use this are
|
||||
;; probably only interested in the following commands:
|
||||
;; - `latex-help-command'
|
||||
;; - `latex-help-environment'
|
||||
;; - `latex-help-package'
|
||||
;; - `latex-help-class'
|
||||
;; - `latex-help-texdoc'
|
||||
;; - `latex-help-at-point'
|
||||
;; - `latex-help'
|
||||
;; The configuration options controlling these can be found by running
|
||||
;; M-x customize-group RET latex-help RET
|
||||
|
||||
;;; Code:
|
||||
(require 'info)
|
||||
(require 'cl-lib)
|
||||
(require 'shr)
|
||||
|
||||
(defcustom latex-help-info-manual "latex2e"
|
||||
"The name of the info manual to use when looking up latex commands."
|
||||
:group 'latex-help
|
||||
:type '(choice
|
||||
(string :tag "English" "latex2e")
|
||||
(string :tag "French" "latex2e-fr")
|
||||
(string :tag "Spanish" "latex2e-es")))
|
||||
|
||||
(defcustom latex-help-buffer-name "*latex-help*"
|
||||
"The name of the info buffer to use when showing LaTeX documentation."
|
||||
:group 'latex-help
|
||||
:type 'string)
|
||||
|
||||
(defcustom latex-help-texdoc-buffer-name "*latex-help-texdoc*"
|
||||
"The name of the buffer to use when showing texdoc files."
|
||||
:group 'latex-help
|
||||
:type 'string)
|
||||
|
||||
(defcustom latex-help-texdoc-program "texdoc"
|
||||
"The program to use when looking things up with texdoc."
|
||||
:group 'latex-help
|
||||
:type '(string :tag "Executable name"))
|
||||
|
||||
(defcustom latex-help-max-texdoc-entries 10
|
||||
"Maximum number of texdoc entries to show when prompting."
|
||||
:group 'latex-help
|
||||
:type 'interger)
|
||||
|
||||
(defcustom latex-help-pdf-view-program '(emacs "evince")
|
||||
"The program to use to view PDF documentation files."
|
||||
:group 'latex-help
|
||||
:type '(choice
|
||||
(string :tag "External program")
|
||||
(const :tag "Texdoc default" texdoc)
|
||||
(function :tag "Custom function")
|
||||
(list :tag "Emacs Doc-View mode"
|
||||
(const :tag "Emacs will be used as the default" emacs)
|
||||
(choice :tag "Backup"
|
||||
(string :tag "Use external program as a backup")
|
||||
(const :tag "Use texdoc default as a backup" texdoc)
|
||||
(function :tag "Use a custom function as a backup")))))
|
||||
|
||||
(defcustom latex-help-html-view-program 'emacs
|
||||
"The program to use to view HTML documentation files."
|
||||
:group 'latex-help
|
||||
:type '(choice
|
||||
(string :tag "External program")
|
||||
(const :tag "Texdoc default" texdoc)
|
||||
(const :tag "Emacs internal HTML engine" emacs)
|
||||
(function :tag "Custom function")))
|
||||
|
||||
(defcustom latex-help-documentation-roots '("/usr/share/texmf-dist/doc/")
|
||||
"The directories to search to discover texdoc entries."
|
||||
:group 'latex-help
|
||||
:type '(repeat directory))
|
||||
|
||||
(defvar latex-help--class-cache nil
|
||||
"Cache of discovered LaTeX document classes.")
|
||||
|
||||
(defvar latex-help--environment-cache nil
|
||||
"Cache of discovered LaTeX environments.")
|
||||
|
||||
(defvar latex-help--package-cache nil
|
||||
"Cache of discovered LaTeX packages.")
|
||||
|
||||
(defvar latex-help--commands-cache nil
|
||||
"Cache of discovered of LaTeX commands.
|
||||
These do NOT have a leading '\\'.")
|
||||
|
||||
(defvar latex-help--texdoc-cache nil
|
||||
"Cache of texdoc entries.")
|
||||
|
||||
(defvar latex-help--caches-initialized-p nil
|
||||
"Non-nil if the latex-help caches have been initialized.")
|
||||
|
||||
(defun latex-help--maybe-init-caches ()
|
||||
"Init the latex-help caches if they ware empty."
|
||||
(unless latex-help--caches-initialized-p
|
||||
(setq latex-help--commands-cache (latex-help--discover-commands)
|
||||
latex-help--package-cache (latex-help--discover-packages)
|
||||
latex-help--environment-cache (latex-help--discover-environments)
|
||||
latex-help--class-cache (latex-help--discover-classes)
|
||||
latex-help--texdoc-cache (latex-help--discover-texdoc-entries)
|
||||
latex-help--caches-initialized-p t)))
|
||||
|
||||
(defun latex-help--open-file-with (cmd file)
|
||||
"Open FILE with shell command CMD."
|
||||
(call-process-shell-command (format "%s %s" cmd
|
||||
(shell-quote-argument file))
|
||||
nil 0))
|
||||
|
||||
(defun latex-help--open-file-with-texdoc (file)
|
||||
"Open FILE with texdoc."
|
||||
(call-process latex-help-texdoc-program nil 0 nil "--just-view" file))
|
||||
|
||||
(defun latex-help--texdoc-open-pdf-file (file)
|
||||
"Open the PDF file FILE."
|
||||
(cond
|
||||
((and (listp latex-help-pdf-view-program)
|
||||
(eq (car latex-help-pdf-view-program) 'emacs))
|
||||
(let ((backup (cadr latex-help-pdf-view-program)))
|
||||
(cond
|
||||
((display-graphic-p)
|
||||
(find-file-other-window file))
|
||||
((eq backup 'texdoc)
|
||||
(latex-help--open-file-with-texdoc file))
|
||||
((functionp backup)
|
||||
(funcall backup file))
|
||||
((stringp backup)
|
||||
(latex-help--open-file-with backup file)))))
|
||||
((eq latex-help-pdf-view-program 'texdoc)
|
||||
(latex-help--open-file-with-texdoc file))
|
||||
((functionp latex-help-pdf-view-program)
|
||||
(funcall latex-help-pdf-view-program file))
|
||||
((stringp latex-help-pdf-view-program)
|
||||
(latex-help--open-file-with latex-help-pdf-view-program file))))
|
||||
|
||||
(defun latex-help--pop-to-texdoc-buffer ()
|
||||
"Pop to (and possibly create) the texdoc buffer.
|
||||
The buffer's name is from `latex-help-texdoc-buffer-name'."
|
||||
(pop-to-buffer (get-buffer-create latex-help-texdoc-buffer-name))
|
||||
(setq buffer-read-only t)
|
||||
(special-mode))
|
||||
|
||||
(defun latex-help--texdoc-open-html-file (file)
|
||||
"Open the HTML file FILE."
|
||||
(cond
|
||||
((eq latex-help-html-view-program 'emacs)
|
||||
(latex-help--pop-to-texdoc-buffer)
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(insert-file-contents file nil)
|
||||
(shr-render-region (point-min) (point-max))
|
||||
(goto-char (point-min))))
|
||||
((eq latex-help-html-view-program 'texdoc)
|
||||
(latex-help--open-file-with-texdoc file))
|
||||
((functionp latex-help-html-view-program)
|
||||
(funcall latex-help-html-view-program file))
|
||||
((stringp latex-help-html-view-program)
|
||||
(latex-help--open-file-with latex-help-html-view-program file))))
|
||||
|
||||
(defun latex-help--texdoc-maybe-text-file (file)
|
||||
"Try to open FILE as a text file.
|
||||
Read FILE into a buffer. If it is a text file, show the user that buffer, and
|
||||
return t. Otherwise, kill the buffer and return nil."
|
||||
(with-current-buffer (generate-new-buffer "*latex-help-texdoc-temp*")
|
||||
(setq buffer-read-only t)
|
||||
(special-mode)
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(insert-file-contents file nil)
|
||||
(if (eq buffer-file-coding-system 'no-conversion)
|
||||
;; the file was a binary file
|
||||
(progn
|
||||
(let ((kill-buffer-query-functions nil))
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer (current-buffer))
|
||||
(user-error "File \"%s\" is binary" file)))
|
||||
;; we are good to go
|
||||
(when-let (old-buffer (get-buffer latex-help-texdoc-buffer-name))
|
||||
(kill-buffer old-buffer))
|
||||
(rename-buffer latex-help-texdoc-buffer-name)
|
||||
(pop-to-buffer (current-buffer))))))
|
||||
|
||||
(defun latex-help--texdoc-open-file (file)
|
||||
"Open the texdoc file FILE.
|
||||
This will attempt to detect the file's type and open it with the correct
|
||||
program."
|
||||
(let ((ext (or (file-name-extension file) "")))
|
||||
(cond
|
||||
((string-equal-ignore-case ext "pdf")
|
||||
(latex-help--texdoc-open-pdf-file file))
|
||||
((string-equal-ignore-case ext "html")
|
||||
(latex-help--texdoc-open-html-file file))
|
||||
(t (latex-help--texdoc-maybe-text-file file)))))
|
||||
|
||||
(defun latex-help--get-thing-at-point ()
|
||||
"Return a cons of the LaTeX thing at point and its type (as a symbol).
|
||||
If nothing is found, return nil.
|
||||
The following types are known:
|
||||
- command
|
||||
- package
|
||||
- environment
|
||||
- class
|
||||
|
||||
The following are some examples:
|
||||
- \\textbf{Hello World} -> \\='(\"textbf\" . command)
|
||||
- \\begin{math} (on \"math\") -> \\='(\"math\" . environment)
|
||||
- \\begin{math} (on \"begin\") -> \\='(\"begin\" . command)
|
||||
- \\usepackage{amsmath} (on \"amsmath\") -> \\='(\"amsmath\" . package)
|
||||
- \\usepackage{amsmath} (on \"usepackage\") -> \\='(\"usepackage\" . command)"
|
||||
(save-excursion
|
||||
(let ((orig-point (point)))
|
||||
(when (eq (char-after) ?\\)
|
||||
(forward-char))
|
||||
(when (and (search-backward "\\" nil t)
|
||||
(looking-at (rx "\\"
|
||||
(group (+ (not (any " " "\n" "("
|
||||
"{" "[" "|"
|
||||
"}" "]" ")" "%")))))))
|
||||
(let ((cmd (match-string-no-properties 1)))
|
||||
(if (> (match-end 1) orig-point)
|
||||
(cons cmd 'command)
|
||||
(goto-char orig-point)
|
||||
(condition-case _
|
||||
(progn
|
||||
(backward-up-list nil t t)
|
||||
(when (looking-at (rx "{" (group (+ (not (any "}" "\n"))))))
|
||||
(let ((thing (match-string-no-properties 1)))
|
||||
(cond
|
||||
((equal cmd "usepackage")
|
||||
(cons thing 'package))
|
||||
((or (equal cmd "begin")
|
||||
(equal cmd "end"))
|
||||
(cons thing 'environment))
|
||||
((equal cmd "documentclass")
|
||||
(cons thing 'class))))))
|
||||
;; just return nil
|
||||
((or user-error scan-error)))))))))
|
||||
|
||||
(defun latex-help--is-marker-file (file root)
|
||||
"Return non-nil if FILE is a texdoc marker file under ROOT.
|
||||
A marker file is a file that signifies that its parent is a texdoc entry."
|
||||
(let ((name (file-name-nondirectory file))
|
||||
(dirname (file-name-nondirectory
|
||||
(directory-file-name (file-name-parent-directory file))))
|
||||
(case-fold-search t))
|
||||
(and
|
||||
(not (length= (file-name-split (file-relative-name file root)) 2))
|
||||
(or (string-match (rx bos "readme" (* "." (+ (any (?a . ?z))))) name)
|
||||
(string-match (rx bos "doc" eos) name)
|
||||
(string-match (rx bos "base" eos) name)
|
||||
;; check if file is just its parent directories name with an .tex or
|
||||
;; .pdf
|
||||
(string-match (format "^%s[-0-9]*\\.\\(?:tex\\|pdf\\)$"
|
||||
(regexp-quote dirname))
|
||||
name)))))
|
||||
|
||||
(defun latex-help--search-texdoc-root (root found)
|
||||
"Search the texdoc root directory ROOT and discover package names.
|
||||
FOUND is the hash table in which to put the entries."
|
||||
(cl-loop with to-search = nil
|
||||
for dir = root then (pop to-search)
|
||||
while dir
|
||||
when (file-directory-p dir) do
|
||||
(let ((files (directory-files dir t)))
|
||||
(if (cl-member-if (lambda (file)
|
||||
(latex-help--is-marker-file file root))
|
||||
files)
|
||||
;; dir is an entry
|
||||
(puthash (file-name-nondirectory dir) nil found)
|
||||
;; search all subdirs
|
||||
(setq to-search
|
||||
(nconc to-search
|
||||
(seq-filter
|
||||
(lambda (file)
|
||||
(let ((name (file-name-nondirectory file)))
|
||||
(and (not (equal name "."))
|
||||
(not (equal name "..")))))
|
||||
files)))))))
|
||||
|
||||
(defun latex-help--texdoc-config-files ()
|
||||
"Return a list of texdoc config files."
|
||||
(with-temp-buffer
|
||||
(call-process latex-help-texdoc-program nil t nil "--files")
|
||||
;; goto line 3
|
||||
(goto-char (point-min))
|
||||
(forward-line 2)
|
||||
(cl-loop while (re-search-forward (rx bol (+ " ") "active" "\t"
|
||||
(group (+ any)) eol) nil t)
|
||||
collect (match-string 1))))
|
||||
|
||||
(defun latex-help--texdoc-config-file-entries (file found)
|
||||
"Parse the texdoc config file FILE to find entries.
|
||||
This attempts to find entries that might have been missed during the initial
|
||||
scan. The entries will be `puthash'ed into FOUND as keys."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (rx bol "adjscore("
|
||||
(group (+ (not ")"))) ")")
|
||||
nil t)
|
||||
(puthash (match-string 1) nil found))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(rx bol "alias" (? "(" (+ (any (?0 . ?9) ".")) ")")
|
||||
" " (group (+ (not " ")))
|
||||
" = " (group (* (not (any "#" "\n" " ")))))
|
||||
nil t)
|
||||
(puthash (match-string 1) nil found)
|
||||
(let ((m2 (match-string 2)))
|
||||
(unless (or (zerop (length m2))
|
||||
(seq-contains-p m2 ?/))
|
||||
(puthash m2 nil found))))))
|
||||
|
||||
(defun latex-help--discover-texdoc-entries ()
|
||||
"Discover texdoc entries in each of `latex-help-documentation-roots'."
|
||||
(let ((found (make-hash-table :test 'equal)))
|
||||
(dolist (root latex-help-documentation-roots)
|
||||
(latex-help--search-texdoc-root root found))
|
||||
(dolist (file (latex-help--texdoc-config-files))
|
||||
(latex-help--texdoc-config-file-entries file found))
|
||||
(cl-loop for entry being the hash-keys of found
|
||||
collect entry)))
|
||||
|
||||
(defun latex-help--texdoc-files-for-entry (entry)
|
||||
"List the texdoc files for ENTRY.
|
||||
This returns a list of conses of the display name of the entry and the file it
|
||||
belongs to. The first item the the returned list is the default value when
|
||||
prompting with `completing-read'."
|
||||
(with-temp-buffer
|
||||
(when-let ((exit-code (call-process latex-help-texdoc-program nil t
|
||||
nil "-Ml" entry))
|
||||
((not (zerop exit-code))))
|
||||
;; try to get the programs output without the normal Emacs process
|
||||
;; sentinel message
|
||||
(goto-char (point-max))
|
||||
(forward-line -2)
|
||||
(end-of-line)
|
||||
(let ((msg (buffer-substring-no-properties (point-min)
|
||||
(point))))
|
||||
(user-error "Texdoc exited with a non-zero code: %d%s"
|
||||
exit-code (if (not (zerop (length msg)))
|
||||
(concat "\n\n" msg)
|
||||
""))))
|
||||
;; the process succeeded, try to extract the files it found
|
||||
(goto-char (point-min))
|
||||
(cl-loop repeat latex-help-max-texdoc-entries
|
||||
while (re-search-forward (rx (and bol (= 2 (+ (not "\t")) "\t")
|
||||
(group (+ (not "\t")))
|
||||
"\t"
|
||||
(? (+ (not "\t")))
|
||||
"\t"
|
||||
(group (* any))))
|
||||
nil t)
|
||||
for file = (match-string 1)
|
||||
for desc = (match-string 2)
|
||||
unless (zerop (length desc))
|
||||
collect (cons (format "%s (%s)" desc file) file)
|
||||
else
|
||||
collect (cons (format "%s (%s)" (file-name-nondirectory file) file)
|
||||
file))))
|
||||
|
||||
(defun latex-help--texdoc-prompt-for-entry-file (entry)
|
||||
"Prompt the user to open a texdoc file from ENTRY.
|
||||
This will return nil if the user does not want to open the file."
|
||||
(let ((entries (latex-help--texdoc-files-for-entry entry)))
|
||||
(if (length= entries 1)
|
||||
(and (y-or-n-p (format "Open texdoc \"%s\"?" (caar entries)))
|
||||
(cdar entries))
|
||||
(let ((ans (completing-read "Texdoc File: " (mapcar 'car entries) nil t
|
||||
nil nil (caar entries))))
|
||||
(unless (zerop (length ans))
|
||||
(cdr (assoc ans entries)))))))
|
||||
|
||||
(defvar latex-help--texdoc-history nil
|
||||
"History for `latex-heklp--list-texdoc-files'.")
|
||||
|
||||
(defun latex-help--prompt-texdoc-entry ()
|
||||
"Ask the user for a texdoc entry."
|
||||
(latex-help--maybe-init-caches)
|
||||
(let* ((tap (latex-help--get-thing-at-point))
|
||||
(has-default-p (and (member (cdr tap) '(package class))
|
||||
(member (car tap) latex-help--texdoc-cache)))
|
||||
(ans (completing-read (format "Texdoc Entry%s: "
|
||||
(if has-default-p
|
||||
(format " (default %s)" (car tap))
|
||||
""))
|
||||
latex-help--texdoc-cache
|
||||
nil nil nil 'latex-help--texdoc-history
|
||||
(and has-default-p (car tap)))))
|
||||
(unless (zerop (length ans))
|
||||
ans)))
|
||||
|
||||
(defun latex-help--run-index-search (regexp)
|
||||
"Search the LaTeX info pages index for REGEXP.
|
||||
This returns a list of cache entries suitable for use in
|
||||
`latex-help--commands-cache'."
|
||||
(with-temp-buffer
|
||||
(Info-mode)
|
||||
(Info-find-node latex-help-info-manual "Index" nil t)
|
||||
(let ((found))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(let ((match (match-string-no-properties 1))
|
||||
(node (match-string-no-properties 2)))
|
||||
(if (equal (caar found) match)
|
||||
(push (cons node (pos-bol)) (cdar found))
|
||||
(push (list match (cons node (pos-bol))) found))))
|
||||
found)))
|
||||
|
||||
(defun latex-help--discover-commands ()
|
||||
"Discover LaTeX commands.
|
||||
This is done by parsing the index for `latex-help-info-manual'."
|
||||
(let ((found (latex-help--run-index-search
|
||||
(rx (and bol "* \\"
|
||||
(group (or
|
||||
","
|
||||
(+ (not (any " " "{" ",")))))
|
||||
(*? any) ":" (+ " ")
|
||||
(group (+? any)) ".")))))
|
||||
(push (list "(SPACE)" "\\(SPACE)") found)
|
||||
(when-let (entry (assoc "(...\\)" found))
|
||||
(setq found (assoc-delete-all "(...\\)" found))
|
||||
(push (cons "(" (cdr entry)) found)
|
||||
(push (cons ")" (cdr entry)) found))
|
||||
(when-let (entry (assoc "[...\\]" found))
|
||||
(setq found (assoc-delete-all "[...\\]" found))
|
||||
(push (cons "[" (cdr entry)) found)
|
||||
(push (cons "]" (cdr entry)) found))
|
||||
found))
|
||||
|
||||
(defun latex-help--discover-packages ()
|
||||
"Discover LaTeX packages.
|
||||
This is done by parsing the index for `latex-help-info-manual'."
|
||||
(latex-help--run-index-search (rx (and bol "* package, "
|
||||
(group (+? any))
|
||||
(any " " ":")
|
||||
(+? any) (+ " ")
|
||||
(group (+? any))
|
||||
"."))))
|
||||
|
||||
(defun latex-help--discover-environments ()
|
||||
"Discover LaTeX environments.
|
||||
This is done by parsing the index for `latex-help-info-manual'."
|
||||
(latex-help--run-index-search (rx (and bol "* environment, "
|
||||
(group (+? any))
|
||||
(any " " ":" "-")
|
||||
(+? any) (+ " ")
|
||||
(group (+? any))
|
||||
"."))))
|
||||
|
||||
(defun latex-help--discover-classes ()
|
||||
"Discover LaTeX document classes.
|
||||
This is done by parsing the index for `latex-help-info-manual'."
|
||||
(latex-help--run-index-search (rx (and bol "* "
|
||||
(group (+ (not (any "," " "))))
|
||||
" class:" (+ " ")
|
||||
(group (+ (not ".")))))))
|
||||
|
||||
(defun latex-help--info-goto-entry (entry)
|
||||
"Open the info page for ENTRY, a cache entry."
|
||||
(let ((buffer (get-buffer-create latex-help-buffer-name)))
|
||||
(with-current-buffer buffer
|
||||
(unless (derived-mode-p 'Info-mode)
|
||||
(Info-mode))
|
||||
(Info-find-node latex-help-info-manual "Index" nil t)
|
||||
(goto-char (cdr entry))
|
||||
(Info-follow-nearest-node))
|
||||
(pop-to-buffer buffer)))
|
||||
|
||||
(defun latex-help--get-cache-for-type (type)
|
||||
"Lookup the cache for TYPE.
|
||||
If the caches are not yet initialized, do that first."
|
||||
(latex-help--maybe-init-caches)
|
||||
(cl-case type
|
||||
(command latex-help--commands-cache)
|
||||
(package latex-help--package-cache)
|
||||
(environment latex-help--environment-cache)
|
||||
(class latex-help--class-cache)))
|
||||
|
||||
(defvar latex-help--info-history nil
|
||||
"History list for `latex-help--prompt-for'.")
|
||||
|
||||
(defun latex-help--maybe-prompt-entry (name type &optional default)
|
||||
"Lookup and prompt the user for the node of NAME.
|
||||
The lookup is performed in the correct cache for TYPE. If there is only one
|
||||
node associated with NAME, return its entry. Otherwise, ask the user which node
|
||||
they want to use.
|
||||
|
||||
If DEFAULT is non-nil, use that instead of prompting. If it does not exist,
|
||||
return nil."
|
||||
(when-let (entries (cdr (assoc name (latex-help--get-cache-for-type type))))
|
||||
(cond
|
||||
(default
|
||||
(assoc default entries))
|
||||
((length= entries 1)
|
||||
(car entries))
|
||||
(t
|
||||
(let ((resp (completing-read "Select Node: " (mapcar 'car entries)
|
||||
nil t nil)))
|
||||
(assoc resp entries))))))
|
||||
|
||||
(defun latex-help--prompt-for (type)
|
||||
"Prompt for a command, environment, etc. from TYPE.
|
||||
This returns the name of the thing that was prompted."
|
||||
(let* ((cache (latex-help--get-cache-for-type type))
|
||||
(tap (latex-help--get-thing-at-point))
|
||||
(default (and (eq (cdr tap) type) (car tap))))
|
||||
(unless (assoc default cache)
|
||||
(setq default nil))
|
||||
(completing-read (format "LaTeX %s%s: "
|
||||
(capitalize (symbol-name type))
|
||||
(if default
|
||||
(format " (default %s)" default)
|
||||
""))
|
||||
(latex-help--get-cache-for-type type)
|
||||
nil t nil 'latex-help--info-history
|
||||
default)))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-command (name &optional node)
|
||||
"Lookup the LaTeX command NAME.
|
||||
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
|
||||
which to use. If NODE is non-nil, use that instead."
|
||||
(interactive (list (latex-help--prompt-for 'command)))
|
||||
(when-let (entry (latex-help--maybe-prompt-entry name 'command node))
|
||||
(latex-help--info-goto-entry entry)))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-environment (name &optional node)
|
||||
"Lookup the LaTeX environment NAME.
|
||||
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
|
||||
which to use. If NODE is non-nil, use that instead."
|
||||
(interactive (list (latex-help--prompt-for 'environment)))
|
||||
(when-let (entry (latex-help--maybe-prompt-entry name 'environment node))
|
||||
(latex-help--info-goto-entry entry)))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-package (name &optional node)
|
||||
"Lookup the LaTeX package NAME.
|
||||
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
|
||||
which to use. If NODE is non-nil, use that instead."
|
||||
(interactive (list (latex-help--prompt-for 'package)))
|
||||
(when-let (entry (latex-help--maybe-prompt-entry name 'package node))
|
||||
(latex-help--info-goto-entry entry)))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-class (name &optional node)
|
||||
"Lookup the LaTeX document class NAME.
|
||||
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
|
||||
which to use. If NODE is non-nil, use that instead."
|
||||
(interactive (list (latex-help--prompt-for 'class)))
|
||||
(when-let (entry (latex-help--maybe-prompt-entry name 'class node))
|
||||
(latex-help--info-goto-entry entry)))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-texdoc (name)
|
||||
"Lookup NAME in the texdoc cache.
|
||||
When used interactively, prompt for NAME."
|
||||
(interactive (list (latex-help--prompt-texdoc-entry)))
|
||||
(latex-help--maybe-init-caches)
|
||||
(when-let ((file (latex-help--texdoc-prompt-for-entry-file name)))
|
||||
(latex-help--texdoc-open-file file)))
|
||||
|
||||
(defun latex-help--prompt-info-and-texdoc (info-entry texdoc-entry)
|
||||
"Prompt the user for both info and texdoc entries.
|
||||
INFO-ENTRY is an entry from one of the info caches. TEXDOC-ENTRY is an entry
|
||||
from the texdoc cache."
|
||||
(let* ((texdoc-files (and texdoc-entry
|
||||
(latex-help--texdoc-files-for-entry
|
||||
texdoc-entry)))
|
||||
(prompts (nconc (mapcar (lambda (file)
|
||||
(concat "(Texdoc) " (car file)))
|
||||
texdoc-files)
|
||||
(mapcar (lambda (node)
|
||||
(concat "(Info) " (car node)))
|
||||
(cdr info-entry)))))
|
||||
(when prompts
|
||||
(let ((selected (completing-read "LaTeX Help: " prompts nil t nil
|
||||
nil (when texdoc-files
|
||||
(car prompts)))))
|
||||
(when (string-match (rx bos "(" (group (+ (any (?a . ?z))
|
||||
(any (?A . ?Z))))
|
||||
") " (group (* any)))
|
||||
selected)
|
||||
(if (equal (match-string 1 selected) "Info")
|
||||
(cons (assoc (match-string 2 selected) (cdr info-entry)) 'info)
|
||||
(cons (cdr (assoc (match-string 2 selected) texdoc-files))
|
||||
'texdoc)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help-at-point ()
|
||||
"Try to lookup the LaTeX thing at point, whatever it may be.
|
||||
This will try to look up the command, package, document class, or environment at
|
||||
point. If that thing at point is valid, it will open an info buffer to the
|
||||
documentation for that thing."
|
||||
(interactive)
|
||||
(latex-help--maybe-init-caches)
|
||||
(if-let (thing (latex-help--get-thing-at-point))
|
||||
(let ((info-entry (assoc (car thing) (latex-help--get-cache-for-type
|
||||
(cdr thing))))
|
||||
(texdoc-entry (and (member (cdr thing) '(class package environment))
|
||||
(cl-find (car thing) latex-help--texdoc-cache
|
||||
:test 'equal))))
|
||||
(unless (or info-entry texdoc-entry)
|
||||
(user-error "Unknown %s: \"%s\""
|
||||
(symbol-name (cdr thing))
|
||||
(if (eq (cdr thing) 'command)
|
||||
(concat "\\" (car thing))
|
||||
(car thing))))
|
||||
(cl-destructuring-bind (thing . type)
|
||||
(latex-help--prompt-info-and-texdoc info-entry texdoc-entry)
|
||||
(cl-case type
|
||||
(texdoc
|
||||
(latex-help--texdoc-open-file thing))
|
||||
(info
|
||||
(latex-help--info-goto-entry thing)))))
|
||||
(user-error "Nothing at point to look up")))
|
||||
|
||||
(defvar latex-help--general-history nil
|
||||
"History for `latex-help'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun latex-help ()
|
||||
"Get help with LaTeX.
|
||||
Prompt the user for an info topic or texdoc file, then open that thing."
|
||||
(interactive)
|
||||
(let ((prompts)
|
||||
(tap (latex-help--get-thing-at-point))
|
||||
(def-entry nil)
|
||||
(def-name nil))
|
||||
(latex-help--maybe-init-caches)
|
||||
(cl-flet ((add-cache-for-type (type)
|
||||
(dolist (entry (latex-help--get-cache-for-type type))
|
||||
(push (format "(Info) %s - %s"
|
||||
(capitalize (symbol-name type))
|
||||
(car entry))
|
||||
prompts)
|
||||
(when (and (eq type (cdr tap))
|
||||
(equal (car entry) (car tap)))
|
||||
(setq def-entry (car prompts)
|
||||
def-name (car entry))))))
|
||||
(add-cache-for-type 'command)
|
||||
(add-cache-for-type 'package)
|
||||
(add-cache-for-type 'class)
|
||||
(add-cache-for-type 'environment)
|
||||
(dolist (entry latex-help--texdoc-cache)
|
||||
(push (format "(Texdoc) %s" entry) prompts)
|
||||
(when (and (member (cdr tap) '(class package environment))
|
||||
(equal entry (car tap)))
|
||||
(setq def-entry (car prompts)
|
||||
def-name entry)))
|
||||
(when-let ((ans (completing-read (format "LaTeX Help%s: "
|
||||
(if def-name
|
||||
(format " (default %s)"
|
||||
def-name)
|
||||
""))
|
||||
prompts
|
||||
nil t nil 'latex-help--general-history
|
||||
def-entry))
|
||||
((not (zerop (length ans)))))
|
||||
(if (string-prefix-p "(Texdoc) " ans)
|
||||
(latex-help-texdoc (seq-subseq ans (length "(Texdoc) ")))
|
||||
(string-match (rx "(Info) " (group (+ (not " ")))
|
||||
" - " (group (+ any)))
|
||||
ans)
|
||||
(when-let ((thing (match-string 2 ans))
|
||||
(type (intern (downcase (match-string 1 ans))))
|
||||
(entry (latex-help--maybe-prompt-entry thing type)))
|
||||
(latex-help--info-goto-entry entry)))))))
|
||||
|
||||
(provide 'latex-help)
|
||||
;;; latex-help.el ends here
|
416
elisp/ltex-eglot.el
Normal file
416
elisp/ltex-eglot.el
Normal file
@ -0,0 +1,416 @@
|
||||
;;; ltex-eglot.el --- LTeX support for Eglot. -*- lexical-binding: t -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
(require 'eglot)
|
||||
|
||||
(defconst ltex-eglot-supported-languages
|
||||
'("ar" "ast-ES" "be-BY" "br-FR" "ca-ES" "ca-ES-valencia" "da-DK" "de" "de-AT"
|
||||
"de-CH" "de-DE" "de-DE-x-simple-language" "el-GR" "en" "en-AU" "en-CA" "en-GB"
|
||||
"en-NZ" "en-US" "en-ZA" "eo" "es" "es-AR" "fa" "fr" "ga-IE" "gl-ES" "it"
|
||||
"ja-JP" "km-KH" "nl" "nl-BE" "pl-PL" "pt" "pt-AO" "pt-BR" "pt-MZ" "pt-PT"
|
||||
"ro-RO" "ru-RU" "sk-SK" "sl-SI" "sv" "ta-IN" "tl-PH" "uk-UA" "zh-CN")
|
||||
"List of languages supportd by LTeX.")
|
||||
|
||||
(defcustom ltex-eglot-server-binary "ltex-ls"
|
||||
"The binary to use for the LTeX LSP server."
|
||||
:group 'ltex-eglot
|
||||
:type 'string)
|
||||
|
||||
(defconst ltex-eglot-modes
|
||||
;; Source:
|
||||
;; https://github.com/emacs-languagetool/eglot-ltex/blob/master/eglot-ltex.el
|
||||
'((org-mode :language-id "org")
|
||||
(git-commit-elisp-text-mode :language-id "gitcommit")
|
||||
(bibtex-mode :language-id "bibtex")
|
||||
(context-mode :language-id "context")
|
||||
(latex-mode :language-id "latex")
|
||||
(LaTeX-mode :language-id "latex")
|
||||
(markdown-mode :language-id "markdown")
|
||||
(rst-mode :language-id "restructuredtext")
|
||||
(text-mode :language-id "plaintext"))
|
||||
"List of major mode that work with LanguageTool.")
|
||||
|
||||
(defcustom ltex-eglot-mother-tounge "en-US"
|
||||
"The user's native language."
|
||||
:group 'ltex-eglot
|
||||
:type '(string :tag "Language Code"))
|
||||
|
||||
(defcustom ltex-eglot-language ltex-eglot-mother-tounge
|
||||
"The main language to use when checking documents."
|
||||
:group 'ltex-eglot
|
||||
:type '(choice :tag "Language"
|
||||
(const :tag "Detect Automatically" "auto")
|
||||
(string :tag "Language Code"))
|
||||
:set-after '(ltex-eglot-mother-tounge)
|
||||
:safe 'stringp)
|
||||
|
||||
(defcustom ltex-eglot-enable-spell-check nil
|
||||
"Weather or not to enable spell checking with LTeX."
|
||||
:group 'ltex-eglot
|
||||
:type '(choice :tag "Status"
|
||||
(const :tag "Enabled" t)
|
||||
(const :tag "Disabled" nil)))
|
||||
|
||||
(defcustom ltex-eglot-spell-check-rules
|
||||
'(:en-US ["EN_CONTRACTION_SPELLING" "MORFOLOGIK_RULE_EN_US"])
|
||||
"Rules to disable if `ltex-eglot-enable-spell-check' is nil."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist :tag "Entries by language"
|
||||
:key-type (string :tag "Language Code")
|
||||
:value-type (repeat :tag "Rules" string)))
|
||||
|
||||
(defun ltex-eglot--entry-file-p (entry)
|
||||
"Check if ENTRY would be concidered a file by LTex LSP."
|
||||
(when (stringp entry)
|
||||
(string-prefix-p ":" entry)))
|
||||
|
||||
(defun ltex-eglot--non-file-settings-plist-p (plist)
|
||||
"Return non-nil if none of the values of PLIST refer to files.
|
||||
This is meant to check file-local saftey for the likes of
|
||||
`ltex-eglot-disabled-rules'."
|
||||
(cl-loop for (_ entries) on plist by 'cddr
|
||||
when (cl-some 'ltex-eglot--entry-file-p entries)
|
||||
do (cl-return)
|
||||
finally return t))
|
||||
|
||||
(defcustom ltex-eglot-disabled-rules ()
|
||||
"List of diagnostic rules to disable."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist :tag "Entries by language"
|
||||
:key-type (string :tag "Language Code")
|
||||
:value-type (repeat :tag "Rules" string))
|
||||
:safe 'ltex-eglot--non-file-settings-plist-p)
|
||||
|
||||
(defcustom ltex-eglot-enabled-rules ()
|
||||
"List of diagnostic rules to enable."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist :tag "Entries by language"
|
||||
:key-type (string :tag "Language Code")
|
||||
:value-type (repeat :tag "Rules" string))
|
||||
:safe 'ltex-eglot--non-file-settings-plist-p)
|
||||
|
||||
(defcustom ltex-eglot-dictionary ()
|
||||
"List of words in the LTeX dictionary."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist :tag "Entries by language"
|
||||
:key-type (string :tag "Language Code")
|
||||
:value-type (repeat :tag "Words" string))
|
||||
:safe 'ltex-eglot--non-file-settings-plist-p)
|
||||
|
||||
(defun ltex-eglot--valid-latex-environments-p (plist)
|
||||
"Check if PLIST is an OK value for the `ltex-eglot-latex-environemnts'."
|
||||
(cl-loop for (name handling) on plist by 'cddr
|
||||
unless (and (stringp name)
|
||||
(member handling '("ignore" "default")))
|
||||
do (cl-return)
|
||||
finally return t))
|
||||
|
||||
(defcustom ltex-eglot-latex-environments ()
|
||||
"Plist controlling the handling of LaTeX environments."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist
|
||||
:tag "Environments"
|
||||
:key-type (string :tag "Name")
|
||||
:value-type (choice :tag "Handling"
|
||||
(const :tag "Ignore" "ignore")
|
||||
(const :tag "Check" "default")))
|
||||
:safe 'ltex-eglot--valid-latex-plist-p)
|
||||
|
||||
(defun ltex-eglot--valid-latex-commands-p (plist)
|
||||
"Check if PLIST is an OK value for the `ltex-eglot-latex-commands'."
|
||||
(cl-loop for (name handling) on plist by 'cddr
|
||||
unless (and (stringp name)
|
||||
(member handling '("ignore" "default" "dummy"
|
||||
"pluralDummy" "vowelDummy")))
|
||||
do (cl-return)
|
||||
finally return t))
|
||||
|
||||
(defcustom ltex-eglot-latex-commands ()
|
||||
"Plist controlling the handling of LaTeX commands."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist
|
||||
:tag "Commands"
|
||||
:key-type (string :tag "Name")
|
||||
:value-type (choice :tag "Handling"
|
||||
(const :tag "Default" "default")
|
||||
(const :tag "Ignore" "ignore")
|
||||
(const :tag "Replace with dummy word" "dummy")
|
||||
(const :tag "Replace with dummy plural word"
|
||||
"pluralDummy")
|
||||
(const :tag "Replace with dummy vowel word"
|
||||
"vowelDummy")))
|
||||
:safe 'ltex-eglot--valid-latex-plist-p)
|
||||
|
||||
(defun ltex-eglot--valid-bibtex-plist-p (plist)
|
||||
"Return non-nil if PLIST is an OK value for BibTeX options."
|
||||
(cl-loop for (name handling) on plist by 'cddr
|
||||
unless (and (stringp name)
|
||||
(booleanp handling))
|
||||
do (cl-return)
|
||||
finally return t))
|
||||
|
||||
(defcustom ltex-eglot-bibtex-fields ()
|
||||
"Plist controlling the handling of BibTeX fields."
|
||||
:group 'ltex-eglot
|
||||
:type '(plist
|
||||
:tag "Fields"
|
||||
:key-type (string :tag "Name")
|
||||
:value-type (choice :tag "Handling"
|
||||
(const :tag "Ignore" nil)
|
||||
(const :tag "Check" t)))
|
||||
:safe 'ltex-eglot--valid-bibtex-plist-p)
|
||||
|
||||
(defcustom ltex-eglot-enable-picky-rules nil
|
||||
"Weather or not to enable picky rules."
|
||||
:group 'ltex-eglot
|
||||
:type '(choice :tag "Status"
|
||||
(const :tag "Enabled" t)
|
||||
(const :tag "Disabled" nil))
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom ltex-eglot-variable-save-method 'dir
|
||||
"How to save variables added by quick fixes.
|
||||
This is one of the following:
|
||||
- \\='dir\tSave in .dir-locals.el
|
||||
- \\='file\tSave as a file local variable
|
||||
- nil\tJust set the buffer local value, don't save the variable"
|
||||
:group 'ltex-eglot
|
||||
:type '(choice :tag "Save method"
|
||||
(const :tag "Directory local (saved)" dir)
|
||||
(const :tag "File local (saved)" file)
|
||||
(const :tag "Buffer local (not saved)" nil))
|
||||
:safe 'symbolp)
|
||||
|
||||
(defvar ltex-eglot-hidden-false-positives nil
|
||||
"List of hidden false positives.
|
||||
This is intented to be set from .dir-locals.el.")
|
||||
(put 'ltex-eglot-hidden-false-positives 'safe-local-variable
|
||||
'ltex-eglot--non-file-settings-plist-p)
|
||||
|
||||
(defun ltex-eglot--merge-options-plists (value-type &rest lists)
|
||||
"Merge each of the options plist LISTS.
|
||||
The values of each of the props can be any sequence, and will be converted to
|
||||
VALUE-TYPE. Any keys will be converted to keyword symbols if they are strings."
|
||||
(let ((output))
|
||||
(dolist (list lists output)
|
||||
(cl-loop for (prop value) on list by 'cddr
|
||||
for norm-prop = (if (stringp prop)
|
||||
(intern (concat ":" prop))
|
||||
prop)
|
||||
do
|
||||
(setf (plist-get output norm-prop)
|
||||
(cl-coerce (seq-uniq
|
||||
(seq-concatenate 'list
|
||||
(plist-get output norm-prop)
|
||||
value))
|
||||
value-type))))))
|
||||
|
||||
(defun ltex-eglot--process-and-add-global (global &rest lists)
|
||||
"Merge each of LISTS with `ltex-eglot--merge-options-plists'.
|
||||
If the result of the merger results in a list with the key t, merge GLOBAL in as
|
||||
well."
|
||||
(let ((merged (apply 'ltex-eglot--merge-options-plists 'vector lists)))
|
||||
(cl-loop with found-t = nil
|
||||
for (prop value) on merged by 'cddr
|
||||
when (eq prop t) do
|
||||
(setq found-t t)
|
||||
else collect prop into output
|
||||
and collect value into output
|
||||
finally return
|
||||
(if found-t
|
||||
(ltex-eglot--merge-options-plists 'vector output global)
|
||||
output))))
|
||||
|
||||
(defun ltex-eglot--make-plist-props-symbols (plist)
|
||||
"Make each of PLIST's props a symbol by calling `intern' on it."
|
||||
(cl-loop for (prop value) on plist by 'cddr
|
||||
collect (if (stringp prop)
|
||||
(intern (concat ":" prop))
|
||||
prop)
|
||||
collect value))
|
||||
|
||||
(defun ltex-eglot--process-bibtex-fields-plist (plist)
|
||||
"Process a PLIST that might be `ltex-eglot-bibtex-fields'."
|
||||
(cl-loop for (prop value) on plist by 'cddr
|
||||
collect (if (stringp prop)
|
||||
(intern (concat ":" prop))
|
||||
prop)
|
||||
collect (or value :json-false)))
|
||||
|
||||
;; The ltex server doesn't work with eglot when running in standard io mode
|
||||
(defclass ltex-eglot-server (eglot-lsp-server)
|
||||
((setup-done-p :initform nil
|
||||
:accessor ltex-eglot-server--setup-done-p)
|
||||
(hidden-positives :initform nil
|
||||
:accessor ltex-eglot-server--hidden-positives)
|
||||
(dictionary :initform nil
|
||||
:accessor ltex-eglot-server--dictionary)
|
||||
(disabled-rules :initform nil
|
||||
:accessor ltex-eglot-server--disabled-rules)
|
||||
(language :initform nil
|
||||
:accessor ltex-eglot-server--language))
|
||||
"LTeX server class.")
|
||||
|
||||
(cl-defmethod ltex-eglot--disabled-rules-plist ((server ltex-eglot-server))
|
||||
"Create a plist of disabled rules by language.
|
||||
SERVER is the server from which to get the rules."
|
||||
(ltex-eglot--process-and-add-global
|
||||
(default-value 'ltex-eglot-disabled-rules)
|
||||
(ltex-eglot-server--disabled-rules server)
|
||||
(and (not ltex-eglot-enable-spell-check)
|
||||
ltex-eglot-spell-check-rules)))
|
||||
|
||||
(cl-defmethod ltex-eglot--setup-server ((server ltex-eglot-server))
|
||||
"Setup up SERVER for the first time."
|
||||
;; make sure that dir local stuff is picked up
|
||||
(save-current-buffer
|
||||
(when-let ((buf (cl-first (eglot--managed-buffers server))))
|
||||
(set-buffer buf))
|
||||
(setf
|
||||
;; merger of global values is mediated elsewhere
|
||||
(ltex-eglot-server--hidden-positives server)
|
||||
(if (local-variable-p 'ltex-eglot-hidden-false-positives)
|
||||
ltex-eglot-hidden-false-positives
|
||||
'(t))
|
||||
(ltex-eglot-server--disabled-rules server)
|
||||
(if (local-variable-p 'ltex-eglot-disabled-rules)
|
||||
ltex-eglot-disabled-rules
|
||||
'(t))
|
||||
(ltex-eglot-server--dictionary server)
|
||||
(if (local-variable-p 'ltex-eglot-dictionary)
|
||||
ltex-eglot-dictionary
|
||||
'(t))
|
||||
(ltex-eglot-server--language server) ltex-eglot-language
|
||||
(ltex-eglot-server--setup-done-p server) t)))
|
||||
|
||||
(cl-defmethod ltex-eglot--build-workspace-settings-plist ((server ltex-eglot-server))
|
||||
"Build the workspace settings plist for SERVER."
|
||||
(unless (ltex-eglot-server--setup-done-p server)
|
||||
(ltex-eglot--setup-server server))
|
||||
(list
|
||||
:language (ltex-eglot-server--language server)
|
||||
:dictionary (ltex-eglot--process-and-add-global
|
||||
(default-value 'ltex-eglot-dictionary)
|
||||
(ltex-eglot-server--dictionary server))
|
||||
:disabledRules (ltex-eglot--disabled-rules-plist server)
|
||||
:enabledRules (ltex-eglot--merge-options-plists
|
||||
'vector
|
||||
ltex-eglot-enabled-rules)
|
||||
:hiddenFalsePositives (ltex-eglot--process-and-add-global
|
||||
(default-value 'ltex-eglot-hidden-false-positives)
|
||||
(ltex-eglot-server--hidden-positives server))
|
||||
:latex (list :commands (ltex-eglot--make-plist-props-symbols
|
||||
ltex-eglot-latex-commands)
|
||||
:environments (ltex-eglot--make-plist-props-symbols
|
||||
ltex-eglot-latex-environments))
|
||||
:bibtex (list :fields (ltex-eglot--process-bibtex-fields-plist
|
||||
ltex-eglot-bibtex-fields))
|
||||
:additionalRules (list :motherTongue ltex-eglot-mother-tounge
|
||||
:enablePickyRules
|
||||
(or ltex-eglot-enabled-rules :json-false))))
|
||||
|
||||
(defun ltex-eglot--cleanup-plist-for-dir-locals (plist)
|
||||
"Cleanup PLIST for use in a .dir-locals.el file."
|
||||
(cl-loop with has-global = nil
|
||||
for (prop value) on plist by 'cddr
|
||||
when (eq prop t) do
|
||||
(setq has-global t)
|
||||
else collect prop into output
|
||||
and collect value into output
|
||||
finally
|
||||
(when has-global
|
||||
(cl-callf nconc output (list t)))
|
||||
finally return output))
|
||||
|
||||
(cl-defmethod ltex-eglot--set-variable ((server ltex-eglot-server)
|
||||
variable value)
|
||||
"Set VARIABLE to VALUE in each buffer for SERVER.
|
||||
Also, maybe save VARIABLE in .dir-locals.el or as a file local variable."
|
||||
(cl-case ltex-eglot-variable-save-method
|
||||
(dir (add-dir-local-variable nil variable value))
|
||||
(file (add-file-local-variable variable value)))
|
||||
(dolist (buf (eglot--managed-buffers server))
|
||||
(setf (buffer-local-value variable buf) value)))
|
||||
|
||||
(defun ltex-eglot--handle-client-action (server command slot)
|
||||
"Handle the client side action COMMAND for SERVER.
|
||||
SLOT is a slot in SERVER."
|
||||
(let* ((arg (cl-case slot
|
||||
(disabled-rules :ruleIds)
|
||||
(hidden-positives :falsePositives)
|
||||
(dictionary :words)))
|
||||
(local-var (cl-case slot
|
||||
(disabled-rules 'ltex-eglot-disabled-rules)
|
||||
(hidden-positives 'ltex-eglot-hidden-false-positives)
|
||||
(dictionary 'ltex-eglot-dictionary)))
|
||||
(args (elt (plist-get command :arguments) 0))
|
||||
(newval (ltex-eglot--merge-options-plists
|
||||
'list
|
||||
(slot-value server slot) (plist-get args arg))))
|
||||
(setf (slot-value server slot) newval)
|
||||
(ltex-eglot--set-variable server local-var newval)
|
||||
(eglot-signal-didChangeConfiguration server)))
|
||||
|
||||
(cl-defmethod eglot-execute ((server ltex-eglot-server) action)
|
||||
"Handler for LTeX actions.
|
||||
ACTION is the action which to run on SERVER."
|
||||
(let ((kind (plist-get action :kind)))
|
||||
(pcase kind
|
||||
("quickfix.ltex.disableRules"
|
||||
(ltex-eglot--handle-client-action server (plist-get action :command)
|
||||
'disabled-rules))
|
||||
("quickfix.ltex.hideFalsePositives"
|
||||
(ltex-eglot--handle-client-action server (plist-get action :command)
|
||||
'hidden-positives))
|
||||
("quickfix.ltex.addToDictionary"
|
||||
(ltex-eglot--handle-client-action server (plist-get action :command)
|
||||
'dictionary))
|
||||
(_ (cl-call-next-method)))))
|
||||
|
||||
(defun ltex-eglot--hack-server-config (oldfun server &optional path)
|
||||
"Hack the config for SERVER into the return of ODLFUN.
|
||||
PATH is the same as for OLDFUN, which is probably
|
||||
`eglot--workspace-configuration-plist'."
|
||||
(let ((conf (funcall oldfun server path)))
|
||||
(when (ltex-eglot-server-p server)
|
||||
(let ((ltex-conf (plist-get conf :ltex)))
|
||||
(cl-loop for (prop val) on
|
||||
(ltex-eglot--build-workspace-settings-plist server)
|
||||
by 'cddr
|
||||
unless (plist-member ltex-conf prop)
|
||||
do (setf (plist-get ltex-conf prop) val))
|
||||
(setf (plist-get conf :ltex) ltex-conf)))
|
||||
conf))
|
||||
|
||||
(defun ltex-eglot-set-language (language server &optional no-save)
|
||||
"Set the SERVER's language to LANGUAGE.
|
||||
When called interactively, prompt for LANGUAGE. With NO-SAVE, don't save the
|
||||
language setting in any file."
|
||||
(interactive (list (completing-read "Language"
|
||||
ltex-eglot-supported-languages)
|
||||
(eglot-current-server)
|
||||
current-prefix-arg))
|
||||
(unless (ltex-eglot-server-p server)
|
||||
(user-error "Current server is not an LTeX server!"))
|
||||
(when-let ((server (eglot-current-server)))
|
||||
(setf (ltex-eglot-server--language server) language)
|
||||
(let ((ltex-eglot-variable-save-method
|
||||
(and (not no-save)
|
||||
ltex-eglot-variable-save-method)))
|
||||
(ltex-eglot--set-variable server 'ltex-eglot-language language))
|
||||
(eglot-signal-didChangeConfiguration server)))
|
||||
|
||||
;;;###autoload
|
||||
(add-to-list 'eglot-server-programs
|
||||
(cons ltex-eglot-modes
|
||||
(list
|
||||
'ltex-eglot-server
|
||||
ltex-eglot-server-binary "--server-type" "TcpSocket"
|
||||
"--no-endless" "--port" :autoport)))
|
||||
|
||||
;;;###autoload
|
||||
(advice-add 'eglot--workspace-configuration-plist :around
|
||||
'ltex-eglot--hack-server-config)
|
||||
|
||||
(provide 'ltex-eglot)
|
||||
;;; ltex-eglot.el ends here
|
365
elisp/org-mu4e-compose.el
Normal file
365
elisp/org-mu4e-compose.el
Normal file
@ -0,0 +1,365 @@
|
||||
;;; org-mu4e-compose.el --- Write mu4e messages with org-mode. -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
|
||||
;; I use evil. This file does not depend on evil, but some of these keybindings
|
||||
;; shadow useful org keybinding with message mode keybindings because the org
|
||||
;; bindings being shadowed are available with evil under some other key sequence.
|
||||
|
||||
;;; Code:
|
||||
(require 'mu4e)
|
||||
(require 'org-mime)
|
||||
(require 'shr)
|
||||
(require 'dom)
|
||||
(require 'sgml-mode)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar-local org-mu4e--html-message-p t
|
||||
"Weather or not the current message should be htmlized.")
|
||||
|
||||
(defvar-local org-mu4e--override-org-mode-check nil
|
||||
"Internal variable.
|
||||
See `org-mu4e--override-org-mode-check-advice' for information about what this
|
||||
does.")
|
||||
|
||||
(defvar org-mu4e--internal-message-mode-function
|
||||
(symbol-function 'mu4e-compose-mode)
|
||||
"The `message-mode' (or derived mode) used by `org-mu4e-compose-mode'.")
|
||||
|
||||
(defun org-mu4e--override-org-mode-check-advice (oldfun &rest r)
|
||||
"Around advice for various org mode functions.
|
||||
This function will call OLDFUN with arguments R with `major-mode' let-bound to
|
||||
\\='org-mode when `org-mu4e--override-org-mode-check' is t."
|
||||
(let ((major-mode (if org-mu4e--override-org-mode-check
|
||||
'org-mode
|
||||
major-mode)))
|
||||
(apply oldfun r)))
|
||||
|
||||
(advice-add 'org-element-at-point :around
|
||||
'org-mu4e--override-org-mode-check-advice)
|
||||
|
||||
(defun org-mu4e-toggle-htmlize-mssage (&optional arg no-message)
|
||||
"Toggle weather the current message should be htmlized.
|
||||
If ARG is a positive number or zero, enable htmlization, if it is negative,
|
||||
disable it. Otherwise, toggle it. With NO-MESSAGE, don't display a message
|
||||
about this change."
|
||||
(interactive "P")
|
||||
(setq org-mu4e--html-message-p (or (wholenump arg)
|
||||
(and (not arg)
|
||||
(not org-mu4e--html-message-p))))
|
||||
(unless no-message
|
||||
(message "Message will be %ssent with an HTML part."
|
||||
(if org-mu4e--html-message-p "" "not ")))
|
||||
(force-mode-line-update))
|
||||
|
||||
(defun org-mu4e--bounds-of-mime-part (type)
|
||||
"Find the bounds of the mime part for TYPE in the current buffer."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (and
|
||||
(re-search-forward (rx bol (literal mail-header-separator) eol)
|
||||
nil t)
|
||||
(re-search-forward (rx "<#multipart" (* any) ">")
|
||||
nil t)
|
||||
(re-search-forward (rx "<#part " (* any)
|
||||
"type=" (literal type) (* any) ">")
|
||||
nil t))
|
||||
(let ((start (match-end 0))
|
||||
(end (point-max)))
|
||||
(when (re-search-forward
|
||||
(rx (or (and "<#/" (or "part" "multipart") ">")
|
||||
(and "<#part" (* any) ">")))
|
||||
nil t)
|
||||
(setq end (match-beginning 0)))
|
||||
(cons (1+ start) end)))))
|
||||
|
||||
(defun org-mu4e--pretty-print-fontify-html-part ()
|
||||
"Pretty print and fontify the HTML part of the current buffer."
|
||||
(when-let ((bounds (org-mu4e--bounds-of-mime-part "text/html"))
|
||||
(real-buf (current-buffer)))
|
||||
(save-excursion
|
||||
(let ((content
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring real-buf (car bounds) (cdr bounds))
|
||||
(let (sgml-mode-hook html-mode-hook text-mode-hook)
|
||||
(html-mode))
|
||||
(sgml-pretty-print (point-min) (point-max))
|
||||
(indent-region (point-min) (point-max))
|
||||
(put-text-property (point-min) (point-max) 'fontified nil)
|
||||
(font-lock-ensure)
|
||||
(buffer-string))))
|
||||
(delete-region (car bounds) (cdr bounds))
|
||||
(goto-char (car bounds))
|
||||
(insert content)))))
|
||||
|
||||
(defun org-mu4e--htmlize-and-cleanup ()
|
||||
"HTMLize and cleanup the visible portion of the buffer.
|
||||
This moves point, wrap it in `save-excursion' if that is a problem."
|
||||
(org-mime-htmlize)
|
||||
;; IDK why, but the above function adds a bunch of newlines to the end
|
||||
;; of the buffer.
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (rx (group (* "\n")) "\n" eos) nil t)
|
||||
(delete-region (match-beginning 1)
|
||||
(match-end 1)))
|
||||
(font-lock-ensure)
|
||||
(org-mu4e--pretty-print-fontify-html-part))
|
||||
|
||||
(defun org-mu4e-preview-html ()
|
||||
"Preview the HTML version of the current buffer in a new buffer.
|
||||
Return the newly created buffer."
|
||||
(interactive)
|
||||
(let ((msg-buffer (current-buffer))
|
||||
(buffer (get-buffer-create "*Org-Mu4e HTML Preview*"))
|
||||
(bounds (point-min))
|
||||
(cur-max (point-max)))
|
||||
(without-restriction
|
||||
(with-current-buffer buffer
|
||||
(special-mode)
|
||||
(setq-local org-mu4e--override-org-mode-check t)
|
||||
;; Setup font-lock without all the other pesky major mode stuff
|
||||
(org-set-font-lock-defaults)
|
||||
(font-lock-add-keywords nil message-font-lock-keywords)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring msg-buffer)
|
||||
(narrow-to-region bounds cur-max)
|
||||
(org-mu4e--htmlize-and-cleanup))
|
||||
(goto-char (point-min))))
|
||||
(switch-to-buffer-other-window buffer)
|
||||
buffer))
|
||||
|
||||
(defun org-mu4e-render-preview ()
|
||||
"Render a preview of the HTML message."
|
||||
(interactive)
|
||||
(let ((msg-buffer (current-buffer))
|
||||
(buffer (get-buffer-create "*Org-Mu4e Render Preview*")))
|
||||
(save-excursion
|
||||
(without-restriction
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (rx bol (literal mail-header-separator) eol)
|
||||
nil t)
|
||||
(let* ((start (1+ (match-end 0)))
|
||||
(org-export-with-latex org-mime-org-html-with-latex-default)
|
||||
(org-preview-latex-image-directory
|
||||
(expand-file-name "ltximg/" mm-tmp-directory))
|
||||
(default-directory org-preview-latex-image-directory)
|
||||
(org-html-postamble nil))
|
||||
(narrow-to-region start (point-max))
|
||||
(if-let ((export-data (org-export-as
|
||||
'html nil t nil
|
||||
org-mime-export-options)))
|
||||
(progn
|
||||
(with-current-buffer buffer
|
||||
(special-mode)
|
||||
(let ((inhibit-read-only t)
|
||||
(default-directory
|
||||
org-preview-latex-image-directory))
|
||||
(erase-buffer)
|
||||
(insert export-data)
|
||||
(shr-render-region (point-min) (point-max))
|
||||
;; The above function inserts a text directionality
|
||||
;; character and then two newlines, just to be safe,
|
||||
;; check for them, then hide them
|
||||
(goto-char (point-min))
|
||||
(let ((new-start (point-min)))
|
||||
(when (or (eq (char-after) #x200e)
|
||||
(eq (char-after) #x200f))
|
||||
(cl-incf new-start))
|
||||
(dotimes (_ 2)
|
||||
(forward-char)
|
||||
(when (eq (char-after) ?\n)
|
||||
(cl-incf new-start)))
|
||||
(narrow-to-region new-start (point-max)))))
|
||||
(switch-to-buffer-other-window buffer))
|
||||
(user-error "HTML export failed")))
|
||||
(user-error "Can't find message start in current buffer"))))))
|
||||
|
||||
(defun org-mu4e-send (&optional arg)
|
||||
"HTMLize and send the message in the current buffer.
|
||||
ARG is passed directly to `message-send'."
|
||||
;; This has to return a non-nil value so that org knows we handled the C-c C-c
|
||||
(interactive "P")
|
||||
(let ((modified (buffer-modified-p))
|
||||
;; we only restore the restriction if the sending below fails
|
||||
(old-rest (cons (point-min) (point-max))))
|
||||
(widen)
|
||||
(let ((save-text (buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(condition-case _
|
||||
(progn
|
||||
(when org-mu4e--html-message-p
|
||||
(org-mu4e--htmlize-and-cleanup))
|
||||
(message-send arg)
|
||||
'sent)
|
||||
((or error quit)
|
||||
(erase-buffer)
|
||||
(insert save-text)
|
||||
(narrow-to-region (car old-rest) (cdr old-rest))
|
||||
(restore-buffer-modified-p modified)
|
||||
'failed)))))
|
||||
|
||||
(defun org-mu4e-send-and-exit (&optional arg)
|
||||
"Call `org-mu4e-send', the save and kill the buffer.
|
||||
ARG is passed directly to `message-send'."
|
||||
(interactive "P")
|
||||
(when (eq (org-mu4e-send arg) 'sent)
|
||||
(message-kill-buffer))
|
||||
t ;; this tells org that we have handled the C-c C-c
|
||||
)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-mu4e-compose-new (&rest r)
|
||||
"This is like `mu4e-compose-new', but it utilizes `org-mu4e-compose-mode'.
|
||||
Each of the arguments in R are the same as `mu4e-compose-new', and are directly
|
||||
passed to it."
|
||||
(interactive)
|
||||
;; Save local variables set by `mu4e-compose-new'
|
||||
(let ((org-mu4e--internal-message-mode-function
|
||||
(symbol-function 'mu4e-compose-mode)))
|
||||
(cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
|
||||
(apply 'mu4e-compose-new r))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-mu4e-compose-reply-to (&optional to wide)
|
||||
"This is like `mu4e-compose-reply-to', but utilizes `org-mu4e-compose-mode'.
|
||||
TO and WIDE are the same as `mu4e-compose-reply-to'."
|
||||
(interactive)
|
||||
;; Save local variables set by `mu4e-compose-reply-to'
|
||||
(let ((html-part-p (seq-find (lambda (handle)
|
||||
(equal (mm-handle-media-type (cdr handle))
|
||||
"text/html"))
|
||||
gnus-article-mime-handle-alist))
|
||||
(org-mu4e--internal-message-mode-function
|
||||
(symbol-function 'mu4e-compose-mode)))
|
||||
(cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
|
||||
(let ((buf (mu4e-compose-reply-to to wide)))
|
||||
(with-current-buffer buf
|
||||
(setq org-mu4e--html-message-p
|
||||
;; make the variable look nicer by not having random data in it
|
||||
(not (not html-part-p))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-mu4e-compose-reply (&optional wide)
|
||||
"This is like `mu4e-compose-reply', but utilizes `org-mu4e-compose-mode'.
|
||||
WIDE is the same as `mu4e-compose-reply'."
|
||||
(interactive "P")
|
||||
(org-mu4e-compose-reply-to nil wide))
|
||||
|
||||
;;;###autoload
|
||||
(defvar-keymap org-mu4e-compose-mode-map
|
||||
:parent org-mode-map
|
||||
;; These come straight from `message-mode-map' and override `org-mode-map'
|
||||
"C-c C-f C-t" #'message-goto-to
|
||||
"C-c C-f C-o" #'message-goto-from
|
||||
"C-c C-f C-b" #'message-goto-bcc
|
||||
"C-c C-f C-w" #'message-goto-fcc
|
||||
"C-c C-f C-c" #'message-goto-cc
|
||||
"C-c C-f C-s" #'message-goto-subject
|
||||
"C-c C-f C-r" #'message-goto-reply-to
|
||||
"C-c C-f C-d" #'message-goto-distribution
|
||||
"C-c C-f C-f" #'message-goto-followup-to
|
||||
"C-c C-f C-m" #'message-goto-mail-followup-to
|
||||
"C-c C-f C-k" #'message-goto-keywords
|
||||
"C-c C-f C-u" #'message-goto-summary
|
||||
"C-c C-f C-i" #'message-insert-or-toggle-importance
|
||||
"C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
|
||||
|
||||
;; modify headers (and insert notes in body)
|
||||
"C-c C-f s" #'message-change-subject
|
||||
;;
|
||||
"C-c C-f x" #'message-cross-post-followup-to
|
||||
;; prefix+message-cross-post-followup-to = same without cross-post
|
||||
"C-c C-f t" #'message-reduce-to-to-cc
|
||||
"C-c C-f a" #'message-add-archive-header
|
||||
;; mark inserted text
|
||||
"C-c M-m" #'message-mark-inserted-region
|
||||
"C-c M-f" #'message-mark-insert-file
|
||||
|
||||
"C-c C-b" #'message-goto-body
|
||||
"C-c C-i" #'message-goto-signature
|
||||
|
||||
"C-c C-t" #'message-insert-to
|
||||
"C-c C-f w" #'message-insert-wide-reply
|
||||
"C-c C-f C-e" #'message-insert-expires
|
||||
"C-c M-u" #'message-insert-or-toggle-importance
|
||||
"C-c M-n" #'message-insert-disposition-notification-to
|
||||
|
||||
"C-c C-y" #'message-yank-original
|
||||
"C-c C-M-y" #'message-yank-buffer
|
||||
"C-c C-S-q" #'message-fill-yanked-message
|
||||
"C-c M-s" #'message-insert-signature
|
||||
"C-c M-h" #'message-insert-headers
|
||||
"C-c M-o" #'message-sort-headers
|
||||
|
||||
;; C-c C-c to send and exit is handled by `org-ctrl-c-ctrl-c-hook'
|
||||
"C-c C-s" #'org-mu4e-send
|
||||
"C-c C-k" #'message-kill-buffer
|
||||
"C-c C-d" #'message-dont-send
|
||||
|
||||
"C-c M-k" #'message-kill-address
|
||||
"C-c M-e" #'message-elide-region
|
||||
"C-c M-v" #'message-delete-not-region
|
||||
"C-c M-z" #'message-kill-to-signature
|
||||
"<remap> <split-line>" #'message-split-line
|
||||
"<remap> <beginning-of-buffer>" #'mu4e-compose-goto-top
|
||||
"<remap> <end-of-buffer>" #'mu4e-compose-goto-bottom
|
||||
|
||||
"C-c M-r" #'message-insert-screenshot
|
||||
|
||||
"M-n" #'message-display-abbrev
|
||||
|
||||
"C-c C-a" #'mail-add-attachment
|
||||
"C-c M-t" #'org-mu4e-toggle-htmlize-mssage
|
||||
"C-c M-p C-p" #'org-mu4e-preview-html
|
||||
"C-c M-p C-w" #'org-mu4e-render-preview
|
||||
"C-c C-;" #'mu4e-compose-context-switch)
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode org-mu4e-compose-mode org-mode "mu4e:org-compose"
|
||||
"Major mode for editing mu4e messages with `org-mode' syntax.
|
||||
This is derived from `org-mode', but it also essentially runs
|
||||
`mu4e-compose-mode' and `message-mode'. Therefore, it runs their hooks too."
|
||||
;; Enable all the things from `mu4e-compose-mode' (which derives from
|
||||
;; `message-mode'), but don't let it change the major mode (or other things we
|
||||
;; care about).
|
||||
(when org-mu4e--internal-message-mode-function
|
||||
(let ((major-mode major-mode)
|
||||
(mode-name mode-name)
|
||||
(local-abbrev-table local-abbrev-table)
|
||||
(font-lock-defaults font-lock-defaults)
|
||||
;; some of these are not actually changed, but they are here just in
|
||||
;; case they change in the future...
|
||||
(comment-start comment-start)
|
||||
(comment-end comment-end)
|
||||
(comment-start-skip comment-start-skip)
|
||||
(comment-add comment-add)
|
||||
(comment-style comment-style))
|
||||
(cl-letf (((symbol-function 'kill-all-local-variables) 'ignore)
|
||||
((symbol-function 'use-local-map) 'ignore)
|
||||
((symbol-function 'set-syntax-table) 'ignore))
|
||||
(funcall org-mu4e--internal-message-mode-function))))
|
||||
;; Add `message-mode' keyword and quote highlighting on top of the org syntax
|
||||
;; highlighting
|
||||
(font-lock-add-keywords nil message-font-lock-keywords)
|
||||
(setq-local org-mu4e--override-org-mode-check t)
|
||||
(add-to-list (make-local-variable 'org-ctrl-c-ctrl-c-final-hook)
|
||||
'org-mu4e-send-and-exit)
|
||||
(add-to-list (make-local-variable 'mode-line-misc-info)
|
||||
'(:eval (if org-mu4e--html-message-p
|
||||
"Text/HTML "
|
||||
"Text Only "))))
|
||||
|
||||
;;;###autoload
|
||||
(define-mail-user-agent 'org-mu4e-user-agent
|
||||
#'org-mu4e-compose-new
|
||||
#'org-mu4e-send-and-exit
|
||||
#'message-kill-buffer
|
||||
'message-send-hook)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-mu4e-user-agent ()
|
||||
"Return `org-mu4e-user-agent'."
|
||||
'org-mu4e-user-agent)
|
||||
|
||||
(provide 'org-mu4e-compose)
|
||||
;;; org-mu4e-compose.el ends here
|
BIN
elisp/private.el
BIN
elisp/private.el
Binary file not shown.
@ -29,10 +29,10 @@
|
||||
|
||||
(defvar kdl-ts-mode--syntax-table
|
||||
(let ((table (make-syntax-table)))
|
||||
(modify-syntax-entry ?= ".")
|
||||
(modify-syntax-entry ?/ ". 124")
|
||||
(modify-syntax-entry ?* ". 23b")
|
||||
(modify-syntax-entry ?\n ">")
|
||||
(modify-syntax-entry ?= "." table)
|
||||
(modify-syntax-entry ?/ ". 124" table)
|
||||
(modify-syntax-entry ?* ". 23b" table)
|
||||
(modify-syntax-entry ?\n ">" table)
|
||||
table)
|
||||
"Syntax table for `kdl-ts-mode'.")
|
||||
|
Reference in New Issue
Block a user