Compare commits

...

172 Commits

Author SHA1 Message Date
72c9dc87a5 Fix mines-mode 2025-07-02 20:53:49 +09:00
2d85457f5d Fix circular list 2025-06-30 20:25:58 +09:00
a23464a17a Attempt to fix dape info modes 2025-06-29 19:00:16 +09:00
b7dd3010a0 Fix completion-preview 2025-06-24 20:44:57 +09:00
73530f887f Fix bug in eshell-starship 2025-06-21 19:50:23 +09:00
19d559d626 Disable forge 2025-05-19 22:48:27 +09:00
5bb3c77e3c Update mu4e stuff 2025-04-29 22:54:18 +09:00
b036ee2a32 Add consult-history binding 2025-04-22 00:32:34 +09:00
00bdf1e8eb Fix some magit stuff I seem to have broken 2025-04-17 23:51:39 +09:00
8112f6b1dc Fix trusted-content-p 2025-04-01 20:54:20 +09:00
e0c8453dfe Remove ros2 stuff 2025-03-19 08:27:36 +09:00
78ad4f0ba6 Update variable name 2025-02-28 21:57:13 -08:00
95fe0861c9 Fix trusted-content for remote directories 2025-02-28 19:55:07 -08:00
b723dc961c Fix mozc in remove files 2025-02-24 22:29:57 -08:00
3883a90da3 Disable tramp-direct-async-process due to hangs 2025-02-24 19:11:04 -08:00
b374fc57e2 Fix tramp eglot stuff 2025-02-22 00:41:04 -08:00
89e010474f Emacs 30.1!!! 2025-02-21 17:43:40 -08:00
226ea54105 Make C-y yank in eat 2025-02-20 21:43:52 -08:00
819d0eda4f Make .clangd files yaml mode 2025-02-20 20:38:28 -08:00
997be323f5 Add my/always-use-eat 2025-02-20 20:33:00 -08:00
2d072241a7 Update elisp/arch-ros2.el 2025-02-20 20:28:42 -08:00
0fd70fb03c Add arch-ros2.el to init.el 2025-02-20 20:10:54 -08:00
90fbbda854 Readd arch-ros2.el 2025-02-20 20:10:04 -08:00
a5e3bd4c11 A bunch of changes 2025-02-18 06:24:16 -08:00
2a2264be9f Add local-init.el (support) 2025-02-18 01:22:00 -08:00
dabf480e7d Change back to eshell for remote connections 2025-02-17 21:46:40 -08:00
b1d77b0f5d Better distrobox and sudo tramp support 2025-02-17 21:21:52 -08:00
6ea87de1b5 (Hopefully) fix elisp/inferior-cc.el 2025-02-16 03:33:33 -08:00
386e65c0f4 Some (more) jupyter stuff 2025-02-14 03:31:10 -08:00
e158df3fd1 Add repl for javascript 2025-02-13 05:44:08 -08:00
816e696f47 Many changes 2025-02-13 00:13:43 -08:00
e2db4e1193 Add jshell stuff 2025-02-12 03:00:19 -08:00
3ebc12ddc9 Modify eglot stuff 2025-02-11 21:41:51 -08:00
173178313e Disable the mozc fixes 2025-02-11 14:10:08 -08:00
2313ad1b25 Add arch-ros2 2025-02-11 05:37:03 -08:00
a3c1ccb6c7 Fix warning message on startup 2025-02-11 03:21:59 -08:00
de206d7b93 Fix eat in terminal and eat char mode with evil 2025-02-11 01:15:55 -08:00
3f23480cb9 Add some evil fixes to eat 2025-02-10 23:26:17 -08:00
d65948ca41 Add pyenv support 2025-02-09 14:05:12 -08:00
655eb827e1 Change to a different method for fixing kkp and map-y-or-n-p 2025-02-09 03:43:36 -08:00
87ec1690ee Temporarily fix mozc.el 2025-02-09 01:20:21 -08:00
a6a712ea99 Change some add-to-list calls to add-hook calls 2025-02-08 18:02:56 -08:00
427b70f347 Clean up my/bibtex-in-entry-p 2025-02-08 17:33:34 -08:00
641aa325dc Fix kkp for the latest update 2025-02-08 15:40:52 -08:00
4282129190 Enable rainbow-delimiters-mode in the sly mrepl 2025-02-08 15:07:40 -08:00
58b6608cbb Fontify the sly mrepl 2025-02-08 04:30:49 -08:00
91a54013b9 Make sure Jupyter syntax highlighting works on first run 2025-02-08 00:27:16 -08:00
9c413aaa38 Add jupyter stuff 2025-02-08 00:09:42 -08:00
c8ba0ce0ca Change the world clock list 2025-02-07 00:27:06 -08:00
9a6a9fcbf8 Disable apheleia auto-format in awk buffers 2025-02-06 17:05:01 -08:00
fd942c275f Make which-key not show evil operator maps 2025-02-06 16:49:54 -08:00
6a1d358548 Refresh the eww message count whenever a message is updated in mu4e 2025-02-06 15:41:39 -08:00
719a2ffac7 Prevent awk from being auto-formatted 2025-02-06 15:13:19 -08:00
2af97af4dd Clean up eww code 2025-02-05 20:54:55 -08:00
9611655fa0 Link fcitx and emacs's input method 2025-02-04 20:59:13 -08:00
44c3cde2c5 Some json stuff 2025-02-04 18:10:31 -08:00
5a3735644d Make which-key show evil operator maps 2025-01-27 05:02:40 -08:00
b33937f50b Pyvenv support 2025-01-27 03:31:38 -08:00
4dfd389998 Fix hyperspec 2025-01-21 05:22:45 -08:00
7b03b977ac Fix hyperspec 2025-01-12 01:42:58 -08:00
21d861dbd0 Disable org-mu4e 2025-01-06 15:23:34 -08:00
9a9a707a10 Add migemo 2025-01-06 01:47:38 -08:00
14467fb9f8 Make the scratch buffer trusted 2025-01-03 20:16:54 -08:00
96c175e0bb Make eshell buffers always trusted 2025-01-03 15:12:19 -08:00
966c3392aa A few more changes 2025-01-01 04:39:28 -08:00
7ef055bc51 Fix the last commit 2025-01-01 03:29:45 -08:00
6d3b19fe46 Hopefully finish trusted-files.el 2025-01-01 03:17:50 -08:00
bebd49f14a Work on trusted-dirs.el 2024-12-30 06:00:19 -08:00
af17d6e0dc Complete the "env" directive in firejail-mode.el 2024-12-29 15:41:24 -08:00
c49caf7a25 Rewrite firejail-mode.el 2024-12-29 15:30:26 -08:00
54e58aca7e Take another crack at making sure WAYLAND_DISPLAY is set 2024-12-26 18:19:52 -08:00
0d1d4e10c1 Update firejail-mode.el 2024-12-26 00:11:10 -08:00
02122f979b More changes!!! 2024-12-25 23:43:36 -08:00
83d40e3713 Fix TypeScript tree-sitter 2024-12-25 22:05:40 -08:00
100fe208e2 Add some new magit stuff 2024-12-25 20:23:52 -08:00
101342c5e3 TypeScript stuff 2024-12-25 19:26:48 -08:00
459705d05a Random JS changes 2024-12-25 19:06:19 -08:00
ed237a2e03 Don't auto-revert dired buffers 2024-12-25 17:02:02 -08:00
82e2f5d753 Fix dirvish tty rendering 2024-12-25 04:27:45 -08:00
e1b18eeefe Fix last commit 2024-12-25 03:22:27 -08:00
80a0d4aefe Auto-format added to init.el 2024-12-25 02:41:17 -08:00
b307a21e11 Dirvish, easy-escape, and devdocs 2024-12-24 03:50:06 -08:00
96b64a144e Some more small changes 2024-12-22 15:19:28 -08:00
dc789627c0 Fix bug in eshell-starship.el 2024-12-22 05:33:07 -08:00
09914fc3a9 Make eshell-starship.el more efficient 2024-12-22 05:22:45 -08:00
c2001ae2b3 Fix previous commit 2024-12-22 00:18:50 -08:00
b6ddcd03c0 All ability to set icon face to eshell-starship.el 2024-12-22 00:16:15 -08:00
f81f0c6a15 Rewrite eshell-starship.el 2024-12-21 21:38:15 -08:00
39efc3d5ba Add more eshell-starship modules 2024-12-20 20:22:23 -08:00
b794eebeb7 Add src path and fix dashboard image 2024-12-20 18:59:40 -08:00
6cdd4f6aa3 Add GLSL mode 2024-12-20 17:16:10 -08:00
190627d982 Better bibtex URL highlighting and matching 2024-12-20 16:11:38 -08:00
b148423914 Fix some bugs and random things 2024-12-20 15:16:44 -08:00
5c3c492fd8 Undo kkp tab and return decoding 2024-12-09 23:09:36 -08:00
535dc0313e Fix sly mrepl thing 2024-12-05 08:41:44 -08:00
8d7aba02d3 Add some more kkp stuff 2024-12-05 08:00:20 -08:00
19e2d6fd59 Update init.el 2024-12-04 14:09:05 -08:00
f6b37f1b10 Add visual-regexp 2024-12-02 16:37:47 -08:00
32b3042418 Fix kkp, again 2024-11-19 19:25:21 -08:00
4e94728235 Some more kkp stuff 2024-11-19 18:13:37 -08:00
bf1f2a7bfa Remove lualatex stuff (because I read the docs) 2024-11-13 08:58:52 -08:00
e7392c6c09 Modify my/kill-some-buffers 2024-11-07 22:06:44 -08:00
a0249716b6 Disable agressive-indent-mode 2024-11-07 10:18:48 -08:00
f9f7badd76 Fix wl-copy (again) 2024-11-06 18:04:13 -08:00
2cd476d2b1 Fix xclip-mode to not print an error when there is no selection 2024-11-06 16:51:48 -08:00
738cd67f00 Fix latex-help.el 2024-11-06 08:42:48 -08:00
222fcacfeb Add sly stuff to my/diagnostic-at-point 2024-11-05 21:20:57 -08:00
04fa288627 Fix some more kkp stuff 2024-11-05 10:06:00 -08:00
998d5cf3fa Fix error handling in crofu-terminal-popupinfo.el 2024-11-05 08:50:06 -08:00
ac07328aca Make sure my/kill-some-buffers asks about all buffers on tty frames 2024-11-04 13:41:54 -08:00
2ef42f86dc Fix kkp not being enabled in the first tty frame 2024-11-03 07:03:25 -08:00
4dc28f50d7 Properly handle tab and backtab in kkp-enabled terminals 2024-11-03 05:47:25 -08:00
71fb77f758 Fix last commit 2024-11-01 09:48:16 -07:00
5d09db86a0 Add some Embark stuff 2024-11-01 09:40:43 -07:00
a5e9144d63 User newer key binding functions 2024-10-31 18:19:54 -07:00
6708db3bdc Merge branch 'main' of ssh://git.zander.im/Zander671/emacs-config 2024-10-31 16:53:23 -07:00
4fc82fb461 Some embark stuff 2024-10-31 16:53:02 -07:00
91594d0e52 Fix typo in README.md 2024-10-28 15:43:46 -07:00
980408f6cc Fix a auctex bug 2024-10-27 14:15:03 -07:00
ab96feb519 Add comment syntax to firejail-mode 2024-10-24 23:35:56 -07:00
d4d5da7c62 Add LuaLaTeX to TeX-command-list 2024-10-24 19:04:41 -07:00
0769a67281 Fix line number mode being disabled by calc 2024-10-23 00:56:08 -07:00
f4a675c225 Add csv-mode 2024-10-23 00:18:47 -07:00
6ce7d9aaed Fix environment command in LaTeX-mode 2024-10-21 17:17:35 -07:00
d77e600000 Reduce amount of auto-staring 2024-10-21 17:12:25 -07:00
22c70eaaa6 Make reply work with org-mu4e-mode 2024-10-21 04:56:01 -07:00
888a8158d9 Fix small message attachment issue 2024-10-20 04:57:13 -07:00
e9e4e89930 Fix read-extended-command-predicate 2024-10-20 02:03:00 -07:00
b54abacff3 A *TON* of changes 2024-10-20 00:44:30 -07:00
003bc783d7 Fix some bugs 2024-10-17 21:14:45 -07:00
a0e268b1a9 A bunch more changes 2024-10-17 20:28:16 -07:00
34e599de92 Fix adjust-parens indent stuff 2024-10-16 23:10:20 -07:00
68aa9afd18 Once more, a whole bunch of mostly bug fixes 2024-10-16 21:32:23 -07:00
48d546c561 Some evil-cp work 2024-10-16 16:56:08 -07:00
f55065d312 A bunch of changes 2024-10-16 01:52:45 -07:00
4f53be9f33 Doc view mode stuff 2024-10-15 21:02:09 -07:00
97bc04e3ad Make proced mode truncate lines 2024-10-15 17:32:33 -07:00
b1f3a1a9f4 Many improvements to corfu 2024-10-15 17:09:11 -07:00
a0a1738ff6 Some more changes 2024-10-14 21:38:33 -07:00
a83f5ea6c1 Some changes 2024-10-14 16:12:36 -07:00
7cd012f02b Optimize texdoc discovery in latex-help.el 2024-10-14 14:27:31 -07:00
cc91d6b7b7 Update stuff 2024-10-14 02:10:55 -07:00
566d338a9a A bunch more changes 2024-10-12 04:38:43 -07:00
267f209037 Fix some stuff 2024-10-11 11:36:25 -07:00
9ae0d7a93f Update latex-help and some other stuff 2024-10-10 06:42:08 -07:00
a6ba5e74a3 A bunch of changes 2024-10-09 07:32:06 -07:00
2c08ad6436 Add my/kill-some-buffers 2024-10-08 21:45:10 -07:00
7d01b9791f Some random changes 2024-10-08 16:35:45 -07:00
e79ade8554 Only show trailing whitespace in acutal text or prog buffers 2024-10-05 05:01:02 -07:00
046ba351ce Fix some stuff from the last commit 2024-10-05 02:55:22 -07:00
93ed2b9e39 Add some extra bibtex stuff 2024-10-05 02:34:48 -07:00
cf50a7c5b7 Change to AUCTeX 2024-10-04 12:49:16 -07:00
a5672f9284 Change back to corfu (crash was GTK3 mem leak) 2024-10-02 17:00:28 -07:00
ea8d6bfe57 Merge branch 'main' of ssh://git.zander.im/Zander671/emacs-config 2024-10-02 16:51:58 -07:00
e985a615b4 Jinx for spellchecking 2024-10-02 16:45:46 -07:00
5e54de5f92 Merge branch 'main' of ssh://git.zander.im/Zander671/emacs-config 2024-09-28 04:22:44 -07:00
7c2cb2f54d Add auto-cleanup to eglot documentation buffer 2024-09-28 04:22:14 -07:00
e7b13a1350 Merge branch 'main' of ssh://git.zander.im/Zander671/emacs-config 2024-09-26 16:45:55 -07:00
49c373d58b Add bookmark-default.el to recentf exclude 2024-09-26 16:32:45 -07:00
69e77a7449 Fix ace-window in eat eshell 2024-09-20 12:03:09 -07:00
269a3fa9d9 Make the plist indent fixes apply only to elisp mode 2024-09-16 14:56:20 -07:00
7ebb1e095e Some changes 2024-09-16 00:44:50 -07:00
abb4ce7925 Change when rainbow-delimiters darkens parenthesis 2024-09-14 15:53:14 -07:00
a33e41de3d Try to fix eglot warning 2024-09-14 15:40:29 -07:00
7b96dad1f8 Use evil-cleverparens in lisp modes, and electric-pair elsewhere 2024-09-14 15:29:37 -07:00
af9fc9efdf Enable evil-cleverparens in prog-mode (not just lisp-mode) 2024-09-14 14:50:03 -07:00
06ec526b97 Add documentation 2024-09-14 02:16:54 -07:00
3c033515ad Change mu4e-attachment-dir 2024-09-13 23:48:23 -07:00
389b3d1891 Add wgrep 2024-09-13 05:46:16 -07:00
85242cd785 Add my/bookmark-find-file 2024-09-13 05:17:00 -07:00
718b24d5e9 Allow adjust-parens to be used from normal state too 2024-09-13 01:48:59 -07:00
1e13252624 Fix my/describe-symbol-at-point 2024-09-13 01:36:02 -07:00
15 changed files with 7368 additions and 778 deletions

2
.gitignore vendored
View File

@ -5,3 +5,5 @@
/tree-sitter/
/tramp
/dape-breakpoints
flycheck_init.el
local-init.el*

674
LICENSE Normal file
View 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
View 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`.

View File

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

View 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

View File

@ -1,98 +1,254 @@
;;; 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)))
"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)
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"
(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"
@ -100,35 +256,607 @@ dbus-\\(system\\|user\\) +\\(none\\|filter\\)?\\)" . 2))
"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")
"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
'("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" "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
View 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

View File

@ -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
(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)))
lines)))
(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)
(cond
((string-prefix-p "Do you want to open the editor again? " line)
(if (y-or-n-p (format "%sReopen the editor? "
(or error-msg
"Unknown error")))
(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"))
(setq error-msg (concat error-msg "\n" line)))))
(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>"
(push (format "%s <%s>"
name
email)))))
output))
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
View 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
View 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
View 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

Binary file not shown.

2454
init.el

File diff suppressed because it is too large Load Diff

View File

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