Compare commits

...

83 Commits

Author SHA1 Message Date
ceb703a085 add autoloads, clean up dashboard, load indent-guide for python 2025-06-22 23:02:25 +02:00
cb7dc65bcf add autoloads 2025-06-22 22:41:49 +02:00
91f37c15fe add autoloads 2025-06-22 22:39:40 +02:00
f98d583977 clean up 2025-06-22 22:38:10 +02:00
e3eab820ce add semantic to python 2025-06-22 22:37:39 +02:00
ca60fa910e add autoloads 2025-06-22 22:36:32 +02:00
cf727799c2 not enable package.el installed packages 2025-06-22 22:18:06 +02:00
7f7c0af81a package now built-in 2025-06-22 19:45:41 +02:00
3b921ba7c8 ignore cache folder 2025-06-22 17:14:27 +02:00
16a0a6db93 update packages 2025-06-22 17:08:08 +02:00
54e5633369 pacakge built-in inside magit 2025-06-22 16:52:13 +02:00
3258d571cb package are built-in inside emacsql 2025-06-22 16:48:41 +02:00
b8349a56eb packages are now built-in 2025-06-22 16:47:44 +02:00
bcf8bd4420 autoloads for lisp direct single files 2025-06-20 19:55:01 +02:00
c3b89cc11c load autoloads 2025-06-20 19:47:06 +02:00
241b1684c5 add autoloads 2025-06-19 16:58:21 +02:00
e6e5602f48 change loading of tab-bar 2025-06-18 23:09:11 +02:00
0d6d2afaec reformating 2025-06-18 23:06:44 +02:00
3511f44aa5 reformating 2025-06-18 23:06:05 +02:00
20d612c301 define scroll-mode via use-package 2025-06-18 16:18:40 +02:00
97e7d3c881 add dependency for tool-bar 2025-06-18 16:07:31 +02:00
612300aef0 fix mouse-mode for terminals 2025-06-18 16:04:41 +02:00
beb2daaf06 fix tool-bar call 2025-06-18 16:03:47 +02:00
d4702c24f6 fix my-help 2025-06-17 21:42:22 +02:00
280b19d614 fix ob-python 2025-06-17 17:21:04 +02:00
56022f7f8b load theme earlier, update awesome-tray 2025-06-16 22:40:01 +02:00
5a1ee56a85 update config 2025-06-16 15:16:28 +02:00
b295a1328b add focus mode in menu 2025-06-15 22:56:42 +02:00
79b15d7822 add function to get filename of buffer 2025-06-15 22:55:25 +02:00
a310ee8795 update/fix dashboard 2025-06-15 22:54:08 +02:00
3a0b45f037 activate window-divider-mode 2025-06-15 17:47:49 +02:00
83bb13b270 increase vertical window divider to 2px 2025-06-15 17:45:22 +02:00
e0913c23d6 add my-help button and change scratch buffer to fundamental-mode 2025-06-15 17:44:24 +02:00
d74e4459cf add custom theme 2025-06-15 17:41:53 +02:00
9fd9666127 update my-help 2025-06-15 17:37:45 +02:00
4aad0ba8f2 deactivate tool-bar 2025-06-15 17:20:23 +02:00
c4cb079682 fix python view 2025-06-14 22:46:40 +02:00
f66a2d37e1 eglot eldoc with markdown rendering 2025-06-14 22:06:51 +02:00
f3eef8d567 menu in tab-bar 2025-06-14 22:04:41 +02:00
2f868e6b50 deactivate ox-tufte 2025-06-13 20:54:22 +02:00
46cf268dd7 deactivate ol-notmuch 2025-06-13 20:25:06 +02:00
2f27c73b2f deactivate org-appear, org links by default literal 2025-06-13 20:17:49 +02:00
348cc168cc change org-ref-cite-insert-version 2025-06-13 19:48:52 +02:00
423e200458 defer ob-csharp 2025-06-13 19:24:27 +02:00
5721e18608 increased gc threashold during startup 2025-06-13 19:18:20 +02:00
d6f64e66ea set indent-guide-mode off by default, b/c too slow 2025-06-06 12:52:43 +02:00
14dcaaddde update packages 2025-03-11 21:14:26 +01:00
45d49daef0 update packages 2025-02-26 20:16:44 +01:00
59db017445 add publish function 2024-11-22 19:51:47 +01:00
a0e23086ce change doc and snippets for glossary, symbols and acronym entries 2024-11-22 12:05:59 +01:00
4fa60b9497 add example how to define glossary and acronym entries 2024-11-19 17:26:41 +01:00
940979a9fe add docu 2024-07-15 16:04:59 +02:00
9d25a4c02d update latex config 2024-07-15 12:35:06 +02:00
7577659e42 remove deprecated option 2024-07-15 12:19:00 +02:00
6b9f2a0cf1 add org-preview-html 2024-06-14 12:10:52 +02:00
59aaf6fc14 add edit-indirect 2024-06-14 11:39:58 +02:00
504c2b1bfa change my-view-python 2024-05-06 21:13:28 +02:00
156cec64fb update my-view-python 2024-05-06 16:50:56 +02:00
8b80ceda39 change python config, add jupyter and ein 2024-05-05 20:36:39 +02:00
b18d02d8d5 add graphviz dot mode 2024-04-26 20:49:40 +02:00
ddba0ba9cd update docs 2024-03-11 19:48:06 +01:00
94dd0e848e update docs 2024-03-05 11:07:57 +01:00
52815c9fe4 update docs 2024-03-05 10:35:22 +01:00
b11956a890 document org article fontsize option 2024-02-18 17:04:10 +01:00
5e9bb3b882 increase gc during startup, add org article latex option fontsize, deactivate global-emojify-mode 2024-02-18 16:21:27 +01:00
3894350a6a fix dashboard autostart 2023-11-04 20:00:29 +01:00
c43933e9f6 fix dashboard loading icons 2023-11-04 19:52:03 +01:00
3b54a3236d update of packages 2023-11-04 19:26:41 +01:00
e162a12b58 update readme 2023-05-04 16:08:01 +02:00
f3935715a4 fix misspell 2023-03-26 21:02:12 +02:00
a075f93c3e mathjax v2 to v3 2023-03-26 20:57:54 +02:00
6253368410 set ess-r-mode to R-mode, auto start winner-mode, auto load some ox pkgs 2023-03-26 12:36:38 +02:00
ce2c9354ed switch for org-roam to builtin sqlite 2023-01-30 20:51:23 +01:00
900a4d9928 fixes 2023-01-06 12:13:18 +01:00
3476d496a7 delay org-num package 2022-12-30 11:18:14 +01:00
1e9910e471 add new dep 2022-12-29 14:32:41 +01:00
a4e15965bb add idea of distraction free view 2022-12-29 14:32:07 +01:00
99a0d6a185 fix and change bindings and icons 2022-12-29 12:58:01 +01:00
d95f45d049 treemacs update 2022-12-29 12:40:49 +01:00
4fe9a6b7e1 org open link in same window 2022-12-20 20:36:23 +01:00
d861ac5e74 update docs 2022-12-20 20:30:47 +01:00
4b839a12cd Merge branch 'pkgs-update'
update packages, including org-roam
2022-12-20 20:19:22 +01:00
43d61b31d4 add ibuffer filter for unsaved file buffers 2022-12-20 10:14:40 +01:00
1352 changed files with 320218 additions and 335638 deletions

3
.gitignore vendored
View File

@@ -7,6 +7,7 @@ custom.el
# cache files
.cache/
eln-cache
# elpa packages
elpa/
elpa/

333
README.md
View File

@@ -2,11 +2,12 @@
# Table of Contents
1. [Installation](#installation)
2. [Usage](#usage)
3. [Packages](#packages)
4. [Information](#information)
5. [Errors](#errors)
6. [TODOs](#todos)
2. [External programs](#programs)
3. [Usage](#usage)
4. [Packages](#packages)
5. [Information](#information)
6. [Errors](#errors)
7. [TODOs](#todos)
This is an ongoing evolution of Emacs configuration files, inspired by
a bunch of online resources.
@@ -16,17 +17,41 @@ a bunch of online resources.
# Installation
Download repo and point the emacs `init` (and `early-init.el`) file to
this configuration.
Different ways to install:
Or run one of the following install script commands (using curl, wget or fetch).
- **arch-linux:** If `emacs-conf` is available in a `custom` `pacman` repository
pacman -S emacs-conf
ln -s /opt/emacs-conf/init ~/.config/emacs/
ln -s /opt/emacs-conf/early-init.el ~/.config/emacs/
sh -c "$(curl -fsSL http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(wget -O- http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(fetch -o - http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
- **debian:** If `emacs-conf` is available in a `custom` `apt` repository
apt install emacs-conf
ln -s /opt/emacs-conf/init ~/.config/emacs/
ln -s /opt/emacs-conf/early-init.el ~/.config/emacs/
Installation path is `~/.config/emacs`. See details and other
installed linux packages as requirements inside `sripts/install.sh`.
- **manual:** Download or clone git repo and point the emacs `init` and
`early-init.el` file to this configuration.
- **old:** Run one of the following install script commands (using curl,
wget or fetch).
sh -c "$(curl -fsSL http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(wget -O- http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(fetch -o - http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
Installation path is `~/.config/emacs`. See details and other
installed linux packages as requirements inside `sripts/install.sh`.
<a id="programs"></a>
# External programs
- `ripgrep` (optional) used by `counsel-rg` (package `counsel`)
- `texlive-luatex` for `luainputenc.sty` used by org latex export
- `texlive-xetex` for `realscripts.sty` for `KpRoman` used by org latex export
<a id="usage"></a>
@@ -60,7 +85,7 @@ General key bindings and functions
- `C-r` (`query-replace-regexp`) replace text
- `C-x RET f` (`set-buffer-file-coding-system`) e.g. set to =utf-8
- (`decode-coding-region`) e.g. decode to `utf-8` (郭富城Aaron Kwok)
- (`decode-coding-region`) e.g. decode to `utf-8` (e.g. 晴天)
- (`diff-buffer-with-file`) show a diff between buffer (current state) and file (saved state)
<table border="2" cellspacing="0" cellpadding="6" rules="groups" frame="hsides">
@@ -97,35 +122,42 @@ General key bindings and functions
<tr>
<td class="org-left">all-the-icons</td>
<td class="org-right">20220929.2303</td>
<td class="org-right">20230909.2053</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">all-the-icons-ivy-rich</td>
<td class="org-right">20230420.1234</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">amx</td>
<td class="org-right">20210305.118</td>
<td class="org-right">20230413.121</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">anaconda-mode</td>
<td class="org-right">20220922.741</td>
<td class="org-right">20230821.2131</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">async</td>
<td class="org-right">20221217.649</td>
<td class="org-right">20230528.622</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">avy</td>
<td class="org-right">20220910.1936</td>
<td class="org-right">20230420.404</td>
<td class="org-left">melpa</td>
</tr>
@@ -139,35 +171,42 @@ General key bindings and functions
<tr>
<td class="org-left">biblio</td>
<td class="org-right">20210418.406</td>
<td class="org-right">20230202.1721</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">biblio-core</td>
<td class="org-right">20210418.406</td>
<td class="org-right">20230202.1721</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">bibtex-completion</td>
<td class="org-right">20221024.857</td>
<td class="org-right">20230918.953</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">bind-key</td>
<td class="org-right">20221209.2013</td>
<td class="org-right">20230203.2004</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">cfrs</td>
<td class="org-right">20220129.1149</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">citeproc</td>
<td class="org-right">20221216.1238</td>
<td class="org-right">20230228.1414</td>
<td class="org-left">melpa</td>
</tr>
@@ -181,14 +220,14 @@ General key bindings and functions
<tr>
<td class="org-left">company</td>
<td class="org-right">20221206.2122</td>
<td class="org-right">20231023.1033</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">company-anaconda</td>
<td class="org-right">20200404.1859</td>
<td class="org-right">20230821.2126</td>
<td class="org-left">melpa</td>
</tr>
@@ -202,7 +241,14 @@ General key bindings and functions
<tr>
<td class="org-left">company-quickhelp</td>
<td class="org-right">20221212.534</td>
<td class="org-right">20231026.1714</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">company-statistics</td>
<td class="org-right">20170210.1933</td>
<td class="org-left">melpa</td>
</tr>
@@ -214,9 +260,16 @@ General key bindings and functions
</tr>
<tr>
<td class="org-left">compat</td>
<td class="org-right">29.1.4.2</td>
<td class="org-left">elpa-gnu</td>
</tr>
<tr>
<td class="org-left">counsel</td>
<td class="org-right">20221015.936</td>
<td class="org-right">20231025.2311</td>
<td class="org-left">melpa</td>
</tr>
@@ -237,14 +290,14 @@ General key bindings and functions
<tr>
<td class="org-left">dash</td>
<td class="org-right">20221013.836</td>
<td class="org-right">20230714.723</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">dashboard</td>
<td class="org-right">20221206.1228</td>
<td class="org-right">20231031.359</td>
<td class="org-left">melpa</td>
</tr>
@@ -272,7 +325,7 @@ General key bindings and functions
<tr>
<td class="org-left">diff-hl</td>
<td class="org-right">20221007.2147</td>
<td class="org-right">20230807.1516</td>
<td class="org-left">melpa</td>
</tr>
@@ -286,7 +339,28 @@ General key bindings and functions
<tr>
<td class="org-left">elisp-refs</td>
<td class="org-right">20220704.2141</td>
<td class="org-right">20230920.201</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">emacsql</td>
<td class="org-right">20230417.1448</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">emacsql-sqlite</td>
<td class="org-right">20230225.2205</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">emacsql-sqlite-builtin</td>
<td class="org-right">20230409.1847</td>
<td class="org-left">melpa</td>
</tr>
@@ -300,7 +374,7 @@ General key bindings and functions
<tr>
<td class="org-left">ess</td>
<td class="org-right">20221204.1348</td>
<td class="org-right">20230807.1422</td>
<td class="org-left">melpa</td>
</tr>
@@ -314,14 +388,14 @@ General key bindings and functions
<tr>
<td class="org-left">f</td>
<td class="org-right">20220911.711</td>
<td class="org-right">20230823.1159</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">flycheck</td>
<td class="org-right">20221213.107</td>
<td class="org-right">20230813.62</td>
<td class="org-left">melpa</td>
</tr>
@@ -363,7 +437,7 @@ General key bindings and functions
<tr>
<td class="org-left">git-commit</td>
<td class="org-right">20221127.2227</td>
<td class="org-right">20231030.2243</td>
<td class="org-left">melpa</td>
</tr>
@@ -377,21 +451,21 @@ General key bindings and functions
<tr>
<td class="org-left">gnuplot</td>
<td class="org-right">20221112.2049</td>
<td class="org-right">20230323.14</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">helpful</td>
<td class="org-right">20221209.1743</td>
<td class="org-right">20231028.516</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">ht</td>
<td class="org-right">20221031.705</td>
<td class="org-right">20230703.558</td>
<td class="org-left">melpa</td>
</tr>
@@ -426,7 +500,7 @@ General key bindings and functions
<tr>
<td class="org-left">ivy</td>
<td class="org-right">20220926.125</td>
<td class="org-right">20231025.2311</td>
<td class="org-left">melpa</td>
</tr>
@@ -440,35 +514,35 @@ General key bindings and functions
<tr>
<td class="org-left">ivy-rich</td>
<td class="org-right">20210409.931</td>
<td class="org-right">20230425.1422</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">js2-mode</td>
<td class="org-right">20221028.1819</td>
<td class="org-right">20230628.238</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">key-chord</td>
<td class="org-right">20201222.203</td>
<td class="org-right">20230522.223</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">langtool</td>
<td class="org-right">20200529.23</td>
<td class="org-right">20230222.326</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">ledger-mode</td>
<td class="org-right">20220623.1125</td>
<td class="org-right">20230925.1013</td>
<td class="org-left">melpa</td>
</tr>
@@ -482,21 +556,21 @@ General key bindings and functions
<tr>
<td class="org-left">magit</td>
<td class="org-right">20221208.1848</td>
<td class="org-right">20231103.1516</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">magit-section</td>
<td class="org-right">20221127.2227</td>
<td class="org-right">20231014.1405</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">markdown-mode</td>
<td class="org-right">20221210.348</td>
<td class="org-right">20231028.853</td>
<td class="org-left">melpa</td>
</tr>
@@ -510,14 +584,21 @@ General key bindings and functions
<tr>
<td class="org-left">mu4e-maildirs-extension</td>
<td class="org-right">20220517.1852</td>
<td class="org-left">melpa</td>
<td class="org-right">melpa</td>
<td class="org-left">&#xa0;</td>
</tr>
<tr>
<td class="org-left">multiple-cursors</td>
<td class="org-right">20221126.743</td>
<td class="org-right">20230728.518</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">notmuch</td>
<td class="org-right">20231006.2337</td>
<td class="org-left">melpa</td>
</tr>
@@ -529,9 +610,23 @@ General key bindings and functions
</tr>
<tr>
<td class="org-left">olivetti</td>
<td class="org-right">20231104.538</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">ol-notmuch</td>
<td class="org-right">20230511.2048</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org</td>
<td class="org-right">9.6</td>
<td class="org-right">9.6.11</td>
<td class="org-left">elpa-gnu</td>
</tr>
@@ -545,7 +640,7 @@ General key bindings and functions
<tr>
<td class="org-left">org-brain</td>
<td class="org-right">20210706.1519</td>
<td class="org-right">20230217.1908</td>
<td class="org-left">melpa</td>
</tr>
@@ -559,7 +654,7 @@ General key bindings and functions
<tr>
<td class="org-left">org-contrib</td>
<td class="org-right">0.4.1</td>
<td class="org-right">0.4.2</td>
<td class="org-left">elpa-nongnu</td>
</tr>
@@ -587,14 +682,42 @@ General key bindings and functions
<tr>
<td class="org-left">orgit</td>
<td class="org-right">20221127.2228</td>
<td class="org-right">20230917.1001</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org-ref</td>
<td class="org-right">20221129.1925</td>
<td class="org-right">20231101.2355</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org-roam</td>
<td class="org-right">20230307.1721</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org-roam-bibtex</td>
<td class="org-right">20230628.2036</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org-roam-timestamps</td>
<td class="org-right">20221104.1544</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">org-roam-ui</td>
<td class="org-right">20221105.104</td>
<td class="org-left">melpa</td>
</tr>
@@ -608,7 +731,7 @@ General key bindings and functions
<tr>
<td class="org-left">org-superstar</td>
<td class="org-right">20210915.1934</td>
<td class="org-right">20230116.1358</td>
<td class="org-left">melpa</td>
</tr>
@@ -622,14 +745,14 @@ General key bindings and functions
<tr>
<td class="org-left">ov</td>
<td class="org-right">20200326.1042</td>
<td class="org-right">20230522.1117</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">ox-pandoc</td>
<td class="org-right">20220705.1036</td>
<td class="org-right">20230627.643</td>
<td class="org-left">melpa</td>
</tr>
@@ -643,28 +766,28 @@ General key bindings and functions
<tr>
<td class="org-left">ox-tufte</td>
<td class="org-right">20160926.1607</td>
<td class="org-right">20231022.2117</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">page-break-lines</td>
<td class="org-right">20210104.2224</td>
<td class="org-right">20230804.658</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">parsebib</td>
<td class="org-right">20221007.1402</td>
<td class="org-right">20230228.153</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">pdf-tools</td>
<td class="org-right">20221202.1104</td>
<td class="org-right">20230611.239</td>
<td class="org-left">melpa</td>
</tr>
@@ -685,7 +808,14 @@ General key bindings and functions
<tr>
<td class="org-left">php-mode</td>
<td class="org-right">20221112.1616</td>
<td class="org-right">20230929.123</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">pkg-info</td>
<td class="org-right">20150517.1143</td>
<td class="org-left">melpa</td>
</tr>
@@ -699,14 +829,14 @@ General key bindings and functions
<tr>
<td class="org-left">polymode</td>
<td class="org-right">20220820.163</td>
<td class="org-right">20230317.1218</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">popup</td>
<td class="org-right">20220927.161</td>
<td class="org-right">20230819.2306</td>
<td class="org-left">melpa</td>
</tr>
@@ -718,9 +848,16 @@ General key bindings and functions
</tr>
<tr>
<td class="org-left">posframe</td>
<td class="org-right">20230714.227</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">pos-tip</td>
<td class="org-right">20220715.102</td>
<td class="org-right">20230721.834</td>
<td class="org-left">melpa</td>
</tr>
@@ -734,7 +871,7 @@ General key bindings and functions
<tr>
<td class="org-left">pythonic</td>
<td class="org-right">20220723.1741</td>
<td class="org-right">20230821.1733</td>
<td class="org-left">melpa</td>
</tr>
@@ -767,9 +904,23 @@ General key bindings and functions
</tr>
<tr>
<td class="org-left">seq</td>
<td class="org-right">2.24</td>
<td class="org-left">elpa-gnu</td>
</tr>
<tr>
<td class="org-left">simple-httpd</td>
<td class="org-right">20230821.1458</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">spacemacs-theme</td>
<td class="org-right">20221103.1406</td>
<td class="org-right">20230530.1751</td>
<td class="org-left">melpa</td>
</tr>
@@ -783,14 +934,14 @@ General key bindings and functions
<tr>
<td class="org-left">sql-indent</td>
<td class="org-right">1.6</td>
<td class="org-right">1.7</td>
<td class="org-left">elpa-gnu</td>
</tr>
<tr>
<td class="org-left">srefactor</td>
<td class="org-right">20180703.181</td>
<td class="org-right">20230504.617</td>
<td class="org-left">melpa</td>
</tr>
@@ -811,42 +962,49 @@ General key bindings and functions
<tr>
<td class="org-left">swiper</td>
<td class="org-right">20220430.2247</td>
<td class="org-right">20231025.2311</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">systemd</td>
<td class="org-right">20210209.2052</td>
<td class="org-right">20230201.302</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">tablist</td>
<td class="org-right">20231019.1126</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">transient</td>
<td class="org-right">20221202.1727</td>
<td class="org-right">20231103.2312</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">treemacs</td>
<td class="org-right">20221107.2105</td>
<td class="org-right">20231101.115</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">treemacs-magit</td>
<td class="org-right">20220917.1026</td>
<td class="org-right">20230830.1936</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">use-package</td>
<td class="org-right">20221209.2013</td>
<td class="org-right">20230426.2324</td>
<td class="org-left">melpa</td>
</tr>
@@ -860,14 +1018,14 @@ General key bindings and functions
<tr>
<td class="org-left">visual-fill-column</td>
<td class="org-right">20220519.1959</td>
<td class="org-right">20230102.183</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">vterm</td>
<td class="org-right">20221118.1354</td>
<td class="org-right">20230417.424</td>
<td class="org-left">melpa</td>
</tr>
@@ -881,35 +1039,42 @@ General key bindings and functions
<tr>
<td class="org-left">web-mode</td>
<td class="org-right">20221012.8</td>
<td class="org-right">20231025.1927</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">websocket</td>
<td class="org-right">20230809.305</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">which-key</td>
<td class="org-right">20220811.1616</td>
<td class="org-right">20230905.2128</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">with-editor</td>
<td class="org-right">20221127.2243</td>
<td class="org-right">20230917.958</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">yasnippet</td>
<td class="org-right">20200604.246</td>
<td class="org-right">20230914.14</td>
<td class="org-left">melpa</td>
</tr>
<tr>
<td class="org-left">yasnippet-snippets</td>
<td class="org-right">20220713.1234</td>
<td class="org-right">20230815.82</td>
<td class="org-left">melpa</td>
</tr>
</tbody>

View File

@@ -9,17 +9,43 @@ a bunch of online resources.
:PROPERTIES:
:CUSTOM_ID: installation
:END:
Download repo and point the emacs =init= (and =early-init.el=) file to
this configuration.
Or run one of the following install script commands (using curl, wget or fetch).
#+begin_src sh
Different ways to install:
- arch-linux :: If ~emacs-conf~ is available in a ~custom~ ~pacman~ repository
#+begin_src sh
pacman -S emacs-conf
ln -s /opt/emacs-conf/init ~/.config/emacs/
ln -s /opt/emacs-conf/early-init.el ~/.config/emacs/
#+end_src
- debian :: If ~emacs-conf~ is available in a ~custom~ ~apt~ repository
#+begin_src sh
apt install emacs-conf
ln -s /opt/emacs-conf/init ~/.config/emacs/
ln -s /opt/emacs-conf/early-init.el ~/.config/emacs/
#+end_src
- manual :: Download or clone git repo and point the emacs =init= and
=early-init.el= file to this configuration.
- old :: Run one of the following install script commands (using curl,
wget or fetch).
#+begin_src sh
sh -c "$(curl -fsSL http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(wget -O- http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
sh -c "$(fetch -o - http://gitea.weseng.de/daniel/emacs/raw/master/scripts/install.sh)"
#+end_src
Installation path is =~/.config/emacs=. See details and other
installed linux packages as requirements inside =sripts/install.sh=.
#+end_src
Installation path is =~/.config/emacs=. See details and other
installed linux packages as requirements inside =sripts/install.sh=.
* External programs
:PROPERTIES:
:CUSTOM_ID: programs
:END:
- =ripgrep= (optional) used by =counsel-rg= (package =counsel=)
- =texlive-luatex= for =luainputenc.sty= used by org latex export
- =texlive-xetex= for =realscripts.sty= for =KpRoman= used by org latex export
* Usage
:PROPERTIES:
@@ -51,14 +77,15 @@ commands and information.
General key bindings and functions
- =C-r= (=query-replace-regexp=) replace text
- =C-x RET f= (=set-buffer-file-coding-system=) e.g. set to =utf-8
- (=decode-coding-region=) e.g. decode to =utf-8= (郭富城Aaron Kwok)
- (=decode-coding-region=) e.g. decode to =utf-8= (e.g. 晴天)
- (=diff-buffer-with-file=) show a diff between buffer (current state) and file (saved state)
#+begin_src sh :exports results
dir=$HOME/repos/emacs-conf/lisp
dir=$(pwd)/lisp
verinfo() {
#echo -n $1 ''
# $dir: directory of packages
# $1: package name (basenaem and w/o extension)
if test -f $dir/$1.el; then
ver=$(grep -i package-version: $dir/$1.el | cut -d":" -f2 | xargs)
if test -z $ver; then
@@ -71,31 +98,31 @@ verinfo() {
fi
}
pkg_custom=$(
for i in $(echo awesome-tray dialog); do
map_pkg_ver() {
# $1: list of package names, either full path (can include a version) or just the package name
# $2: repo name
# 1st: get package name: strips list element to basename and removes version and extension
# 2nd: get package version (from the installed directory)
# 3rd: print info
for i in $1; do
pkg=$(sed 's/-[0-9].*//' <(basename $i))
ver=$(verinfo $pkg)
echo $pkg $ver custom
done)
pkg_elpagnu=$(
for i in $(ls -F ~/repos/my-elpa-gnu/archive/*.tar | grep -v @); do
pkg=$(sed 's/-[0-9].*//' <(basename $i))
ver=$(verinfo $pkg)
echo $pkg $ver elpa-gnu
done)
pkg_elpanongnu=$(
for i in $(ls -F ~/repos/my-elpa-nongnu/archive/*.tar | grep -v @); do
pkg=$(sed 's/-[0-9].*//' <(basename $i))
ver=$(verinfo $pkg)
echo $pkg $ver elpa-nongnu
done)
pkg_melpa=$(
for i in $(sort <(ls ~/repos/my-melpa/packages/*.tar | xargs -n1) <(ls ~/repos/my-melpa/packages/*.el | xargs -n1)); do
pkg=$(sed 's/-[0-9].*//' <(basename $i))
ver=$(verinfo $pkg)
echo $pkg $ver melpa
done)
echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column -t -N PACKAGE_____________________,VERSION______,REPO_______
echo $pkg $ver $2
done
}
pkg_custom_list=$(echo awesome-tray dialog)
pkg_elpagnu_list=$(ls -F ~/repos/my-elpa-gnu/archive/*.tar | grep -v @)
pkg_elpanongnu_list=$(ls -F ~/repos/my-elpa-nongnu/archive/*.tar | grep -v @)
pkg_melpa_list=$(sort <(ls ~/repos/my-melpa/packages/*.tar | xargs -n1) <(ls ~/repos/my-melpa/packages/*.el | xargs -n1))
pkg_custom=$(map_pkg_ver "$pkg_custom_list" custom)
pkg_elpagnu=$(map_pkg_ver "$pkg_elpagnu_list" elpa-gnu)
pkg_elpanongnu=$(map_pkg_ver "$pkg_elpanongnu_list" elpa-nongnu)
pkg_melpa=$(map_pkg_ver "$pkg_melpa_list" melpa)
echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | \
sort | \
column -t -N PACKAGE_____________________,VERSION______,REPO_______
#+end_src
#+RESULTS:
@@ -103,6 +130,7 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| ace-window | 20220911.358 | melpa |
| adaptive-wrap | 0.8 | elpa-gnu |
| all-the-icons | 20220929.2303 | melpa |
| all-the-icons-ivy-rich | 20221202.1336 | melpa |
| amx | 20210305.118 | melpa |
| anaconda-mode | 20220922.741 | melpa |
| async | 20221217.649 | melpa |
@@ -112,13 +140,16 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| biblio-core | 20210418.406 | melpa |
| bibtex-completion | 20221024.857 | melpa |
| bind-key | 20221209.2013 | melpa |
| cfrs | 20220129.1149 | melpa |
| citeproc | 20221216.1238 | melpa |
| cl-libify | 20181130.23 | melpa |
| company | 20221206.2122 | melpa |
| company-anaconda | 20200404.1859 | melpa |
| company-ledger | 20210910.25 | melpa |
| company-quickhelp | 20221212.534 | melpa |
| company-statistics | 20170210.1933 | melpa |
| company-web | 20220115.2146 | melpa |
| compat | 28.1.2.2 | elpa-gnu |
| counsel | 20221015.936 | melpa |
| crdt | 0.3.5 | elpa-gnu |
| ctable | 20210128.629 | melpa |
@@ -130,6 +161,9 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| diff-hl | 20221007.2147 | melpa |
| dim | 20160818.949 | melpa |
| elisp-refs | 20220704.2141 | melpa |
| emacsql | 20221127.2146 | melpa |
| emacsql-sqlite | 20221127.2146 | melpa |
| emacsql-sqlite-builtin | 20221127.2146 | melpa |
| emojify | 20210108.1111 | melpa |
| ess | 20221204.1348 | melpa |
| ess-R-data-view | 20130509.1158 | melpa |
@@ -163,7 +197,10 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| memoize | 20200103.2036 | melpa |
| mu4e-maildirs-extension | 20220517.1852 | melpa |
| multiple-cursors | 20221126.743 | melpa |
| notmuch | 20221115.1134 | melpa |
| ob-async | 20210428.2052 | melpa |
| olivetti | 20220330.635 | melpa |
| ol-notmuch | 20220428.1337 | melpa |
| org | 9.6 | elpa-gnu |
| org-appear | 20220617.2355 | melpa |
| org-brain | 20210706.1519 | melpa |
@@ -174,6 +211,10 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| org-fragtog | 20220714.2146 | melpa |
| orgit | 20221127.2228 | melpa |
| org-ref | 20221129.1925 | melpa |
| org-roam | 20221205.355 | melpa |
| org-roam-bibtex | 20221104.2139 | melpa |
| org-roam-timestamps | 20221104.1544 | melpa |
| org-roam-ui | 20221105.104 | melpa |
| org-sticky-header | 20201223.143 | melpa |
| org-superstar | 20210915.1934 | melpa |
| org-table-sticky-header | 20190924.506 | melpa |
@@ -187,10 +228,12 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| persist | 0.5 | elpa-gnu |
| pfuture | 20220913.1401 | melpa |
| php-mode | 20221112.1616 | melpa |
| pkg-info | 20150517.1143 | melpa |
| plantuml-mode | 20191102.2056 | melpa |
| polymode | 20220820.163 | melpa |
| popup | 20220927.161 | melpa |
| popwin | 20210215.1849 | melpa |
| posframe | 20221220.544 | melpa |
| pos-tip | 20220715.102 | melpa |
| powershell | 20220805.1712 | melpa |
| pythonic | 20220723.1741 | melpa |
@@ -198,6 +241,8 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| rainbow-mode | 1.0.6 | elpa-gnu |
| restart-emacs | 20201127.1425 | melpa |
| s | 20220902.1511 | melpa |
| seq | 2.23 | elpa-gnu |
| simple-httpd | 20191103.1446 | melpa |
| spacemacs-theme | 20221103.1406 | melpa |
| sphinx-doc | 20210213.125 | melpa |
| sql-indent | 1.6 | elpa-gnu |
@@ -206,8 +251,9 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| string-inflection | 20220910.1306 | melpa |
| swiper | 20220430.2247 | melpa |
| systemd | 20210209.2052 | melpa |
| tablist | 20200427.2205 | melpa |
| transient | 20221202.1727 | melpa |
| treemacs | 20221107.2105 | melpa |
| treemacs | 20221221.1301 | melpa |
| treemacs-magit | 20220917.1026 | melpa |
| use-package | 20221209.2013 | melpa |
| virtual-auto-fill | 20200906.2038 | melpa |
@@ -215,6 +261,7 @@ echo -e "$pkg_custom\n$pkg_elpagnu\n$pkg_elpanongnu\n$pkg_melpa" | sort | column
| vterm | 20221118.1354 | melpa |
| web-completion-data | 20160318.848 | melpa |
| web-mode | 20221012.8 | melpa |
| websocket | 20221218.115 | melpa |
| which-key | 20220811.1616 | melpa |
| with-editor | 20221127.2243 | melpa |
| yasnippet | 20200604.246 | melpa |

View File

@@ -8,7 +8,7 @@
;; A big contributor to startup times is garbage collection. We up the gc
;; threshold to temporarily prevent it from running, then reset it later by
;; enabling `gcmh-mode'. Not resetting it will cause stuttering/freezes.
(setq gc-cons-threshold (* 50 1000 1000)) ;; Make startup faster by reducing the frequency of garbage collection. The default is 800 kilobytes. Measured in bytes. Will be decreased again at the end.
(setq gc-cons-threshold (* 200 1024 1024)) ;; Make startup faster by reducing the frequency of garbage collection. The default is 800 kilobytes. Measured in bytes. Will (and should) be decreased again at the end.
;; make UTF-8 the default coding system:
(set-language-environment "UTF-8")
@@ -35,8 +35,11 @@
;; FRAME
;;
;; (add-to-list 'default-frame-alist '(fullscreen . maximized)) ;; restore saved geometry, see gui-settings.el my-frame-geometry-
(add-to-list 'default-frame-alist '(tool-bar-position . left))
;; (add-to-list 'default-frame-alist '(tool-bar-position . left))
;; (add-to-list 'default-frame-alist '(horizontal-scroll-bars . t)) ;; see gui-settings
(menu-bar-mode -1) ;; menu displayed inside `tab-bar' and via `tmm-menubar'
(when (featurep 'tool-bar)
(tool-bar-mode -1))
;; transparency
(set-frame-parameter (selected-frame) 'alpha '(95 . 95)) ;; VALUE: '(<active> . <inactive>) / <both>
@@ -83,5 +86,27 @@
(if (display-graphic-p)
(add-hook 'kill-emacs-hook 'my-frame-geometry-save))))
(use-package package
:defer t
:init
(setq package-enable-at-startup nil)
:config
(add-to-list 'package-directory-list (concat config-dir "lisp"))
(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/"))
;; (add-to-list 'package-archives '("melpa-stable" . "https://stable.melpa.org/packages/"))
)
;; spacemacs-theme https://github.com/nashamri/spacemacs-theme
(use-package spacemacs-theme
:defer t
:config
(require 'cl-lib) ;; spacemacs-common misses to load cl-lib
(setq spacemacs-theme-comment-bg nil)
;;(load-theme 'spacemacs-dark t)
)
(use-package my-theme
:config
(load-theme 'my t))
(provide 'early-init)
;;; early-init.el ends here

5
init
View File

@@ -11,6 +11,7 @@
;; Requirements: git gnuplot ledger
;;; Code:
;; early-init spacemacs-theme
(require 'early-init
(concat
(file-name-directory (file-truename (or load-file-name
@@ -30,7 +31,7 @@
(require 'general-settings) ;; requires which-key
(require 'my-settings)
(require 'gui-settings) ;; emacs modeline indent rainbow focus dashboard
(require 'theme-settings) ;; spacemacs-theme fonts emojify
(require 'theme-settings) ;; fonts emojify
(require 'popwin-settings) ;; https://melpa.org/#/popwin
(require 'toolbar-settings)
(require 'deft-settings) ;; https://melpa.org/#/deft
@@ -47,7 +48,7 @@
(require 'mail-settings)
;; languages / filetypes
(require 'plot-settings) ;; gnuplot-mode plantuml-mode (dash)
(require 'plot-settings) ;; graphviz-dot gnuplot-mode plantuml-mode (dash)
(require 'ess-settings) ;; requires ess ess-R-data-view ctable popup
(require 'ledger-settings) ;; ledger-mode company-ledger
(require 'python-settings) ;; requires anaconda-mode pythonic company-anaconda

View File

@@ -1,12 +1,10 @@
(define-package "ace-window" "20220911.358" "Quickly switch windows."
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ace-window" "20220911.358"
"Quickly switch windows."
'((avy "0.5.0"))
:commit "77115afc1b0b9f633084cf7479c767988106c196" :authors
'(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainer
'("Oleh Krehel" . "ohwoeowho@gmail.com")
:keywords
'("window" "location")
:url "https://github.com/abo-abo/ace-window")
;; Local Variables:
;; no-byte-compile: t
;; End:
:url "https://github.com/abo-abo/ace-window"
:commit "77115afc1b0b9f633084cf7479c767988106c196"
:revdesc "77115afc1b0b"
:keywords '("window" "location")
:authors '(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainers '(("Oleh Krehel" . "ohwoeowho@gmail.com")))

View File

@@ -5,7 +5,8 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/ace-window
;; Version: 0.10.0
;; Package-Version: 20220911.358
;; Package-Revision: 77115afc1b0b
;; Package-Requires: ((avy "0.5.0"))
;; Keywords: window, location

View File

@@ -0,0 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "all-the-icons-ivy-rich" "20230420.1234"
"Better experience with icons for ivy."
'((emacs "25.1")
(ivy-rich "0.1.0")
(all-the-icons "2.2.0"))
:url "https://github.com/seagle0128/all-the-icons-ivy-rich"
:commit "c098cc85123a401b0ab8f2afd3a25853e61d7d28"
:revdesc "c098cc85123a"
:keywords '("convenience" "icons" "ivy")
:authors '(("Vincent Zhang" . "seagle0128@gmail.com"))
:maintainers '(("Vincent Zhang" . "seagle0128@gmail.com")))

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,70 @@
;;; all-the-icons-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from all-the-icons.el
(autoload 'all-the-icons-icon-for-dir "all-the-icons" "\
Get the formatted icon for DIR.
ARG-OVERRIDES should be a plist containining `:height',
`:v-adjust' or `:face' properties like in the normal icon
inserting functions.
Note: You want chevron, please use `all-the-icons-icon-for-dir-with-chevron'.
(fn DIR &rest ARG-OVERRIDES)")
(autoload 'all-the-icons-icon-for-file "all-the-icons" "\
Get the formatted icon for FILE.
ARG-OVERRIDES should be a plist containining `:height',
`:v-adjust' or `:face' properties like in the normal icon
inserting functions.
(fn FILE &rest ARG-OVERRIDES)")
(autoload 'all-the-icons-icon-for-mode "all-the-icons" "\
Get the formatted icon for MODE.
ARG-OVERRIDES should be a plist containining `:height',
`:v-adjust' or `:face' properties like in the normal icon
inserting functions.
(fn MODE &rest ARG-OVERRIDES)")
(autoload 'all-the-icons-icon-for-url "all-the-icons" "\
Get the formatted icon for URL.
If an icon for URL isn't found in `all-the-icons-url-alist', a globe is used.
ARG-OVERRIDES should be a plist containining `:height',
`:v-adjust' or `:face' properties like in the normal icon
inserting functions.
(fn URL &rest ARG-OVERRIDES)")
(autoload 'all-the-icons-install-fonts "all-the-icons" "\
Helper function to download and install the latests fonts based on OS.
When PFX is non-nil, ignore the prompt and just install
(fn &optional PFX)" t)
(autoload 'all-the-icons-insert "all-the-icons" "\
Interactive icon insertion function.
When Prefix ARG is non-nil, insert the propertized icon.
When FAMILY is non-nil, limit the candidates to the icon set matching it.
(fn &optional ARG FAMILY)" t)
(register-definition-prefixes "all-the-icons" '("all-the-icons-"))
;;; End of scraped data
(provide 'all-the-icons-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; all-the-icons-autoloads.el ends here

View File

@@ -1,9 +1,8 @@
;;; all-the-icons-faces.el --- A module of faces for all-the-icons
;;; all-the-icons-faces.el --- A module of faces for all-the-icons -*- lexical-binding: t; -*-
;; Copyright (C) 2016 Dominic Charlesworth <dgc336@gmail.com>
;; Author: Dominic Charlesworth <dgc336@gmail.com>
;; Version: 1.0.0
;; Package-Requires: ((emacs "24.3"))
;; URL: https://github.com/domtronn/all-the-icons.el
;; Keywords: convenient, lisp

View File

@@ -1,12 +1,10 @@
(define-package "all-the-icons" "20220929.2303" "A library for inserting Developer icons"
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "all-the-icons" "20250527.927"
"A library for inserting Developer icons."
'((emacs "24.3"))
:commit "51bf77da1ebc3c199dfc11f54c0dce67559f5f40" :authors
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainer
'("Dominic Charlesworth" . "dgc336@gmail.com")
:keywords
'("convenient" "lisp")
:url "https://github.com/domtronn/all-the-icons.el")
;; Local Variables:
;; no-byte-compile: t
;; End:
:url "https://github.com/domtronn/all-the-icons.el"
:commit "4778632b29c8c8d2b7cd9ce69535d0be01d846f9"
:revdesc "4778632b29c8"
:keywords '("convenient" "lisp")
:authors '(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainers '(("Dominic Charlesworth" . "dgc336@gmail.com")))

View File

@@ -3,7 +3,8 @@
;; Copyright (C) 2016 Dominic Charlesworth <dgc336@gmail.com>
;; Author: Dominic Charlesworth <dgc336@gmail.com>
;; Version: 5.0.0
;; Package-Version: 20250527.927
;; Package-Revision: 4778632b29c8
;; Package-Requires: ((emacs "24.3"))
;; URL: https://github.com/domtronn/all-the-icons.el
;; Keywords: convenient, lisp
@@ -168,6 +169,12 @@
("dll" all-the-icons-faicon "cogs" :face all-the-icons-silver)
("ds_store" all-the-icons-faicon "cogs" :face all-the-icons-silver)
;; Source Codes
("ada" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("adb" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("adc" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("ads" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("gpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
("cgpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
("scpt" all-the-icons-fileicon "apple" :face all-the-icons-pink)
("aup" all-the-icons-fileicon "audacity" :face all-the-icons-yellow)
("elm" all-the-icons-fileicon "elm" :face all-the-icons-blue)
@@ -184,7 +191,6 @@
("eclass" all-the-icons-fileicon "gentoo" :face all-the-icons-blue)
("go" all-the-icons-fileicon "go" :height 1.0 :face all-the-icons-blue)
("jl" all-the-icons-fileicon "julia" :face all-the-icons-purple :v-adjust 0.0)
("magik" all-the-icons-faicon "magic" :face all-the-icons-blue)
("matlab" all-the-icons-fileicon "matlab" :face all-the-icons-orange)
("nix" all-the-icons-fileicon "nix" :face all-the-icons-blue)
("pl" all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
@@ -210,6 +216,8 @@
("rd" all-the-icons-fileicon "R" :face all-the-icons-lblue)
("rdx" all-the-icons-fileicon "R" :face all-the-icons-lblue)
("rsx" all-the-icons-fileicon "R" :face all-the-icons-lblue)
("beancount" all-the-icons-faicon "credit-card" :face all-the-icons-lgreen)
("ledger" all-the-icons-faicon "credit-card" :face all-the-icons-lgreen)
("svelte" all-the-icons-fileicon "svelte" :v-adjust 0.0 :face all-the-icons-red)
("gql" all-the-icons-fileicon "graphql" :face all-the-icons-dpink)
("graphql" all-the-icons-fileicon "graphql" :face all-the-icons-dpink)
@@ -247,6 +255,7 @@
("sass" all-the-icons-alltheicon "sass" :face all-the-icons-dpink)
("less" all-the-icons-alltheicon "less" :height 0.8 :face all-the-icons-dyellow)
("postcss" all-the-icons-fileicon "postcss" :face all-the-icons-dred)
("pcss" all-the-icons-fileicon "postcss" :face all-the-icons-dred)
("sss" all-the-icons-fileicon "postcss" :face all-the-icons-dred)
("styl" all-the-icons-alltheicon "stylus" :face all-the-icons-lgreen)
("csv" all-the-icons-octicon "graph" :v-adjust 0.0 :face all-the-icons-dblue)
@@ -277,11 +286,14 @@
("react" all-the-icons-alltheicon "react" :height 1.1 :face all-the-icons-lblue)
("ts" all-the-icons-fileicon "typescript" :height 1.0 :v-adjust -0.1 :face all-the-icons-blue-alt)
("js" all-the-icons-alltheicon "javascript" :height 1.0 :v-adjust 0.0 :face all-the-icons-yellow)
("mjs" all-the-icons-alltheicon "javascript" :height 1.0 :v-adjust 0.0 :face all-the-icons-yellow)
("es" all-the-icons-alltheicon "javascript" :height 1.0 :v-adjust 0.0 :face all-the-icons-yellow)
("jsx" all-the-icons-fileicon "jsx-2" :height 1.0 :v-adjust -0.1 :face all-the-icons-cyan-alt)
("tsx" all-the-icons-fileicon "tsx" :height 1.0 :v-adjust -0.1 :face all-the-icons-cyan-alt)
("njs" all-the-icons-alltheicon "nodejs" :height 1.2 :face all-the-icons-lgreen)
("vue" all-the-icons-fileicon "vue" :face all-the-icons-lgreen)
("wasm" all-the-icons-fileicon "wasm" :height 1.0 :face all-the-icons-purple-alt)
("wat" all-the-icons-fileicon "wasm" :height 1.0 :face all-the-icons-purple-alt)
("sbt" all-the-icons-fileicon "sbt" :face all-the-icons-red)
("scala" all-the-icons-alltheicon "scala" :face all-the-icons-red)
@@ -380,12 +392,13 @@
("mov" all-the-icons-faicon "film" :face all-the-icons-blue)
("mp4" all-the-icons-faicon "film" :face all-the-icons-blue)
("ogv" all-the-icons-faicon "film" :face all-the-icons-dblue)
("mpg" all-the-icons-faicon "film" :face all-the-icons-blue)
("mpeg" all-the-icons-faicon "film" :face all-the-icons-blue)
("flv" all-the-icons-faicon "film" :face all-the-icons-blue)
("ogv" all-the-icons-faicon "film" :face all-the-icons-dblue)
("mpg" all-the-icons-faicon "film" :face all-the-icons-blue)
("mpeg" all-the-icons-faicon "film" :face all-the-icons-blue)
("flv" all-the-icons-faicon "film" :face all-the-icons-blue)
("ogv" all-the-icons-faicon "film" :face all-the-icons-dblue)
("mkv" all-the-icons-faicon "film" :face all-the-icons-blue)
("webm" all-the-icons-faicon "film" :face all-the-icons-blue)
("dav" all-the-icons-faicon "film" :face all-the-icons-blue)
;; Fonts
("ttf" all-the-icons-fileicon "font" :v-adjust 0.0 :face all-the-icons-dcyan)
("woff" all-the-icons-fileicon "font" :v-adjust 0.0 :face all-the-icons-cyan)
@@ -397,6 +410,8 @@
("doc" all-the-icons-fileicon "word" :face all-the-icons-blue)
("docx" all-the-icons-fileicon "word" :face all-the-icons-blue)
("docm" all-the-icons-fileicon "word" :face all-the-icons-blue)
("eml" all-the-icons-faicon "envelope" :face all-the-icons-blue)
("msg" all-the-icons-faicon "envelope" :face all-the-icons-blue)
("texi" all-the-icons-fileicon "tex" :face all-the-icons-lred)
("tex" all-the-icons-fileicon "tex" :face all-the-icons-lred)
("md" all-the-icons-octicon "markdown" :v-adjust 0.0 :face all-the-icons-lblue)
@@ -405,7 +420,7 @@
("pps" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
("ppt" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
("pptsx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
("ppttx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
("pptx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
("knt" all-the-icons-fileicon "powerpoint" :face all-the-icons-cyan)
("xlsx" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
("xlsm" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
@@ -577,13 +592,17 @@ for performance sake.")
(erc-mode all-the-icons-faicon "commenting-o" :height 1.0 :v-adjust 0.0)
(inferior-emacs-lisp-mode all-the-icons-fileicon "elisp" :height 1.0 :v-adjust -0.1 :face all-the-icons-lblue)
(dired-mode all-the-icons-octicon "file-directory" :v-adjust 0.0)
(wdired-mode all-the-icons-octicon "file-directory" :v-adjust 0.0 :face all-the-icons-dcyan)
(lisp-interaction-mode all-the-icons-fileicon "lisp" :v-adjust -0.1 :face all-the-icons-orange)
(sly-mrepl-mode all-the-icons-fileicon "clisp" :v-adjust -0.1 :face all-the-icons-orange)
(slime-repl-mode all-the-icons-fileicon "clisp" :v-adjust -0.1 :face all-the-icons-orange)
(org-mode all-the-icons-fileicon "org" :v-adjust 0.0 :face all-the-icons-lgreen)
(typescript-mode all-the-icons-fileicon "typescript" :v-adjust -0.1 :face all-the-icons-blue-alt)
(typescript-ts-mode all-the-icons-fileicon "typescript" :v-adjust -0.1 :face all-the-icons-blue-alt)
(typescript-tsx-mode all-the-icons-fileicon "tsx" :v-adjust -0.1 :face all-the-icons-cyan-alt)
(tsx-ts-mode all-the-icons-fileicon "tsx" :v-adjust -0.1 :face all-the-icons-cyan-alt)
(js-mode all-the-icons-alltheicon "javascript" :v-adjust -0.1 :face all-the-icons-yellow)
(js-ts-mode all-the-icons-alltheicon "javascript" :v-adjust -0.1 :face all-the-icons-yellow)
(js-jsx-mode all-the-icons-alltheicon "javascript" :v-adjust -0.1 :face all-the-icons-yellow)
(js2-mode all-the-icons-alltheicon "javascript" :v-adjust -0.1 :face all-the-icons-yellow)
(js3-mode all-the-icons-alltheicon "javascript" :v-adjust -0.1 :face all-the-icons-yellow)
@@ -602,6 +621,7 @@ for performance sake.")
(ibuffer-mode all-the-icons-faicon "files-o" :v-adjust 0.0 :face all-the-icons-dsilver)
(messages-buffer-mode all-the-icons-faicon "file-o" :v-adjust 0.0 :face all-the-icons-dsilver)
(help-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple)
(helpful-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple)
(benchmark-init/tree-mode all-the-icons-octicon "dashboard" :v-adjust 0.0)
(jenkins-mode all-the-icons-fileicon "jenkins" :face all-the-icons-blue)
(magit-popup-mode all-the-icons-alltheicon "git" :face all-the-icons-red)
@@ -612,6 +632,10 @@ for performance sake.")
(mu4e-main-mode all-the-icons-octicon "mail" :v-adjust 0.0)
(mu4e-view-mode all-the-icons-octicon "mail-read" :v-adjust 0.0)
(sieve-mode all-the-icons-octicon "mail" :v-adjust 0.0)
(gnus-group-mode all-the-icons-octicon "mail" :v-adjust 0.0)
(gnus-summary-mode all-the-icons-octicon "mail" :v-adjust 0.0)
(gnus-article-mode all-the-icons-octicon "mail-read" :v-adjust 0.0)
(message-mode all-the-icons-octicon "pencil" :v-adjust 0.0)
(package-menu-mode all-the-icons-faicon "archive" :height 1.0 :v-adjust 0.0 :face all-the-icons-silver)
(paradox-menu-mode all-the-icons-faicon "archive" :height 1.0 :v-adjust 0.0 :face all-the-icons-silver)
(Custom-mode all-the-icons-octicon "settings" :v-adjust -0.1)
@@ -624,30 +648,39 @@ for performance sake.")
(text-mode all-the-icons-octicon "file-text" :v-adjust 0.0 :face all-the-icons-cyan)
(enh-ruby-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-lred)
(ruby-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-lred)
(ruby-ts-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-lred)
(inf-ruby-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-red)
(projectile-rails-compilation-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-red)
(rspec-compilation-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-red)
(rake-compilation-mode all-the-icons-alltheicon "ruby-alt" :face all-the-icons-red)
(sh-mode all-the-icons-alltheicon "terminal" :face all-the-icons-purple)
(bash-ts-mode all-the-icons-alltheicon "terminal" :face all-the-icons-purple)
(shell-mode all-the-icons-alltheicon "terminal" :face all-the-icons-purple)
(fish-mode all-the-icons-alltheicon "terminal" :face all-the-icons-lpink)
(nginx-mode all-the-icons-fileicon "nginx" :height 0.9 :face all-the-icons-dgreen)
(apache-mode all-the-icons-alltheicon "apache" :height 0.9 :face all-the-icons-dgreen)
(makefile-mode all-the-icons-fileicon "gnu" :face all-the-icons-dorange)
(cmake-mode all-the-icons-fileicon "cmake" :face all-the-icons-red)
(cmake-ts-mode all-the-icons-fileicon "cmake" :face all-the-icons-red)
(dockerfile-mode all-the-icons-fileicon "dockerfile" :face all-the-icons-blue)
(dockerfile-ts-mode all-the-icons-fileicon "dockerfile" :face all-the-icons-blue)
(docker-compose-mode all-the-icons-fileicon "dockerfile" :face all-the-icons-lblue)
(nxml-mode all-the-icons-faicon "file-code-o" :height 0.95 :face all-the-icons-lorange)
(json-mode all-the-icons-octicon "settings" :face all-the-icons-yellow)
(json-ts-mode all-the-icons-octicon "settings" :face all-the-icons-yellow)
(jsonian-mode all-the-icons-octicon "settings" :face all-the-icons-yellow)
(yaml-mode all-the-icons-octicon "settings" :v-adjust 0.0 :face all-the-icons-dyellow)
(yaml-ts-mode all-the-icons-octicon "settings" :v-adjust 0.0 :face all-the-icons-dyellow)
(elisp-byte-code-mode all-the-icons-octicon "file-binary" :v-adjust 0.0 :face all-the-icons-dsilver)
(archive-mode all-the-icons-octicon "file-zip" :v-adjust 0.0 :face all-the-icons-lmaroon)
(elm-mode all-the-icons-fileicon "elm" :face all-the-icons-blue)
(erlang-mode all-the-icons-alltheicon "erlang" :face all-the-icons-red :v-adjust -0.1 :height 0.9)
(elixir-mode all-the-icons-alltheicon "elixir" :face all-the-icons-lorange :v-adjust -0.1 :height 0.9)
(java-mode all-the-icons-alltheicon "java" :height 1.0 :face all-the-icons-purple)
(java-ts-mode all-the-icons-alltheicon "java" :height 1.0 :face all-the-icons-purple)
(go-mode all-the-icons-fileicon "go" :height 1.0 :face all-the-icons-blue)
(go-ts-mode all-the-icons-fileicon "go" :height 1.0 :face all-the-icons-blue)
(go-mod-ts-mode all-the-icons-fileicon "config-go" :height 1.0 :face all-the-icons-blue-alt)
(go-dot-mod-mode all-the-icons-fileicon "config-go" :height 1.0 :face all-the-icons-blue-alt)
(go-dot-work-mode all-the-icons-fileicon "config-go" :height 1.0 :face all-the-icons-blue-alt)
(graphql-mode all-the-icons-fileicon "graphql" :face all-the-icons-dpink)
@@ -656,24 +689,37 @@ for performance sake.")
(perl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
(cperl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
(php-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(php-ts-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(phps-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(prolog-mode all-the-icons-alltheicon "prolog" :height 1.1 :face all-the-icons-lmaroon)
(python-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
(python-ts-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
(inferior-python-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
(racket-mode all-the-icons-fileicon "racket" :height 1.2 :face all-the-icons-red)
(rust-mode all-the-icons-alltheicon "rust" :height 1.2 :face all-the-icons-maroon)
(rustic-mode all-the-icons-alltheicon "rust" :height 1.2 :face all-the-icons-maroon)
(rust-ts-mode all-the-icons-alltheicon "rust" :height 1.2 :face all-the-icons-maroon)
(scala-mode all-the-icons-alltheicon "scala" :face all-the-icons-red)
(scheme-mode all-the-icons-fileicon "scheme" :height 1.2 :face all-the-icons-red)
(swift-mode all-the-icons-alltheicon "swift" :height 1.0 :v-adjust -0.1 :face all-the-icons-green)
(svelte-mode all-the-icons-fileicon "svelte" :v-adjust 0.0 :face all-the-icons-red)
(ada-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
(ada-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
(gpr-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
(gpr-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
(c-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
(c-ts-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
(c++-mode all-the-icons-alltheicon "cplusplus-line" :v-adjust -0.2 :face all-the-icons-blue)
(c++-ts-mode all-the-icons-alltheicon "cplusplus-line" :v-adjust -0.2 :face all-the-icons-blue)
(csharp-mode all-the-icons-alltheicon "csharp-line" :face all-the-icons-dblue)
(csharp-ts-mode all-the-icons-alltheicon "csharp-line" :face all-the-icons-dblue)
(clojure-mode all-the-icons-alltheicon "clojure" :height 1.0 :face all-the-icons-blue)
(cider-repl-mode all-the-icons-alltheicon "clojure" :height 1.0 :face all-the-icons-green)
(clojurescript-mode all-the-icons-fileicon "cljs" :height 1.0 :face all-the-icons-dblue)
(coffee-mode all-the-icons-alltheicon "coffeescript" :height 1.0 :face all-the-icons-maroon)
(lisp-mode all-the-icons-fileicon "lisp" :face all-the-icons-orange)
(css-mode all-the-icons-alltheicon "css3" :face all-the-icons-yellow)
(css-ts-mode all-the-icons-alltheicon "css3" :face all-the-icons-yellow)
(scss-mode all-the-icons-alltheicon "sass" :face all-the-icons-pink)
(sass-mode all-the-icons-alltheicon "sass" :face all-the-icons-dpink)
(less-css-mode all-the-icons-alltheicon "less" :height 0.8 :face all-the-icons-dyellow)
@@ -684,6 +730,7 @@ for performance sake.")
(literate-haskell-mode all-the-icons-alltheicon "haskell" :height 1.0 :face all-the-icons-red)
(haml-mode all-the-icons-fileicon "haml" :face all-the-icons-lyellow)
(html-mode all-the-icons-alltheicon "html5" :face all-the-icons-orange)
(html-ts-mode all-the-icons-alltheicon "html5" :face all-the-icons-orange)
(rhtml-mode all-the-icons-alltheicon "html5" :face all-the-icons-lred)
(mustache-mode all-the-icons-fileicon "moustache" :face all-the-icons-green)
(slim-mode all-the-icons-octicon "dashboard" :v-adjust 0.0 :face all-the-icons-yellow)
@@ -703,6 +750,7 @@ for performance sake.")
(vhdl-mode all-the-icons-fileicon "vhdl" :face all-the-icons-blue)
(haskell-cabal-mode all-the-icons-fileicon "cabal" :face all-the-icons-lblue)
(kotlin-mode all-the-icons-fileicon "kotlin" :face all-the-icons-orange)
(kotlin-ts-mode all-the-icons-fileicon "kotlin" :face all-the-icons-orange)
(nim-mode all-the-icons-fileicon "nimrod" :face all-the-icons-yellow)
(sql-mode all-the-icons-octicon "database" :face all-the-icons-silver)
(lua-mode all-the-icons-fileicon "lua" :face all-the-icons-dblue)
@@ -722,15 +770,24 @@ for performance sake.")
(hy-mode all-the-icons-fileicon "hy" :face all-the-icons-blue)
(glsl-mode all-the-icons-fileicon "vertex-shader" :face all-the-icons-green)
(zig-mode all-the-icons-fileicon "zig" :face all-the-icons-orange)
(exwm-mode all-the-icons-octicon "browser" :v-adjust 0.2 :face all-the-icons-purple)
(beancount-mode all-the-icons-faicon "credit-card" :face all-the-icons-lgreen)
(ledger-mode all-the-icons-faicon "credit-card" :face all-the-icons-lgreen)
(odin-mode all-the-icons-fileicon "odin" :height 1.1 :face all-the-icons-lblue)
(pdf-view-mode all-the-icons-octicon "file-pdf" :v-adjust 0.0 :face all-the-icons-dred)
(spacemacs-buffer-mode all-the-icons-fileicon "elisp" :height 1.0 :v-adjust -0.1 :face all-the-icons-purple)
(elfeed-search-mode all-the-icons-faicon "rss-square" :face all-the-icons-orange)
(elfeed-show-mode all-the-icons-faicon "rss" :face all-the-icons-orange)
(emms-browser-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-lyrics-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-show-all-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-metaplaylist-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-tag-editor-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-playlist-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(lilypond-mode all-the-icons-faicon "music" :face all-the-icons-green)
(magik-session-mode all-the-icons-alltheicon "terminal" :face all-the-icons-blue)
(magik-cb-mode all-the-icons-faicon "book" :face all-the-icons-blue)
(meson-mode all-the-icons-fileicon "meson" :face all-the-icons-purple)
(man-common all-the-icons-fileicon "man-page" :face all-the-icons-blue)))
(man-common all-the-icons-fileicon "man-page" :face all-the-icons-blue)
(ess-r-mode all-the-icons-fileicon "R" :face all-the-icons-lblue)))
(defvar all-the-icons-url-alist
'(
@@ -843,8 +900,8 @@ for performance sake.")
(eq major-mode auto-mode)))
(defun all-the-icons-match-to-alist (file alist)
"Match FILE against an entry in ALIST using `string-match'."
(cdr (cl-find-if (lambda (it) (string-match (car it) file)) alist)))
"Match FILE against an entry in ALIST using `string-match-p'."
(cdr (cl-find-if (lambda (it) (string-match-p (car it) file)) alist)))
(defun all-the-icons-dir-is-submodule (dir)
"Checker whether or not DIR is a git submodule."
@@ -916,20 +973,21 @@ inserting functions.
Note: You want chevron, please use `all-the-icons-icon-for-dir-with-chevron'."
(let* ((dirname (file-name-base (directory-file-name dir)))
(path (expand-file-name dir))
(icon (all-the-icons-match-to-alist dirname all-the-icons-dir-icon-alist))
(args (cdr icon)))
(when arg-overrides (setq args (append `(,(car args)) arg-overrides (cdr args))))
(cond
((file-remote-p path)
(apply #'all-the-icons-octicon "terminal" (cdr args)))
((file-symlink-p path)
(apply #'all-the-icons-octicon "file-symlink-directory" (cdr args)))
((all-the-icons-dir-is-submodule path)
(apply #'all-the-icons-octicon "file-submodule" (cdr args)))
((file-exists-p (format "%s/.git" path))
(apply #'all-the-icons-octicon "repo" (cdr args)))
(t (apply (car icon) args)))))
(if (file-remote-p dir) ;; don't call expand-file-name on a remote dir as this can make emacs hang
(apply #'all-the-icons-octicon "terminal" (cdr args))
(let
((path (expand-file-name dir)))
(cond
((file-symlink-p path)
(apply #'all-the-icons-octicon "file-symlink-directory" (cdr args)))
((all-the-icons-dir-is-submodule path)
(apply #'all-the-icons-octicon "file-submodule" (cdr args)))
((file-exists-p (format "%s/.git" path))
(apply #'all-the-icons-octicon "repo" (cdr args)))
(t (apply (car icon) args)))))))
;;;###autoload
(defun all-the-icons-icon-for-file (file &rest arg-overrides)
@@ -1004,7 +1062,7 @@ inserting functions."
(defun all-the-icons-icon-family-for-file (file)
"Get the icons font family for FILE."
(let* ((ext (file-name-extension file))
(icon (or (all-the-icons-match-to-alist file all-the-icons-regexp-icon-alist)
(icon (or (all-the-icons-match-to-alist file all-the-icons-regexp-icon-alist)
(and ext
(cdr (assoc (downcase ext)
all-the-icons-extension-icon-alist)))
@@ -1164,7 +1222,7 @@ pause for DURATION seconds between printing each character."
(mapc
(lambda (it)
(insert (format "%s - %s\n" (funcall insert-f (car it) :height height) (car it)))
(when duration (sit-for duration 0)))
(when duration (sit-for duration)))
data)))
(defmacro all-the-icons-define-icon (name alist family &optional font-name)
@@ -1219,8 +1277,6 @@ FONT-NAME is the name of the .ttf file providing the font, defaults to FAMILY."
(interactive "P")
(all-the-icons-insert arg (quote ,name)))))
(define-obsolete-function-alias 'define-icon 'all-the-icons-define-icon "4.0.0")
(all-the-icons-define-icon alltheicon all-the-icons-data/alltheicons-alist "all-the-icons")
(all-the-icons-define-icon fileicon all-the-icons-data/file-icon-alist "file-icons")
(all-the-icons-define-icon faicon all-the-icons-data/fa-icon-alist "FontAwesome")

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/alltheicons-alist
'(

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/fa-icon-alist
'(

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/file-icon-alist
'(
@@ -312,7 +314,7 @@
( "objective-j" . "\xe99e" )
( "ocaml" . "\xe91a" )
( "octave" . "\xea33" )
( "odin" . "\eb36" )
( "odin" . "\xeb36" )
( "onenote" . "\xe9eb" )
( "ooc" . "\xe9cb" )
( "opa" . "\x2601" )

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/material-icons-alist
'(("3d_rotation" . "\xe84d")
("ac_unit" . "\xeb3b")

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/octicons-alist
'(

View File

@@ -1,3 +1,5 @@
;; -*- lexical-binding: t -*-
(defvar all-the-icons-data/weather-icons-alist
'(

12
lisp/amx/amx-pkg.el Normal file
View File

@@ -0,0 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "amx" "20230413.1210"
"Alternative M-x with extra features."
'((emacs "24.4")
(s "0"))
:url "http://github.com/DarwinAwardWinner/amx/"
:commit "1c2428d21e9d2ee8bee944b572a39ca8c91ca13b"
:revdesc "1c2428d21e9d"
:keywords '("convenience" "usability" "completion")
:authors '(("Ryan C. Thompson" . "rct@thompsonclan.org")
("Cornelius Mika" . "cornelius.mika@gmail.com"))
:maintainers '(("Ryan C. Thompson" . "rct@thompsonclan.org")))

View File

@@ -8,10 +8,9 @@
;; Cornelius Mika <cornelius.mika@gmail.com>
;; Maintainer: Ryan C. Thompson <rct@thompsonclan.org>
;; URL: http://github.com/DarwinAwardWinner/amx/
;; Package-Version: 20210305.118
;; Package-Commit: 37f9c7ae55eb0331b27200fb745206fc58ceffc0
;; Package-Requires: ((emacs "24.4") (s "0"))
;; Version: 3.4
;; Package-Version: 20230413.1210
;; Package-Revision: 1c2428d21e9d
;; Keywords: convenience, usability, completion
;; This file is not part of GNU Emacs.
@@ -238,6 +237,7 @@ nil) if you don't find it useful."
"\\`self-insert-and-exit\\'"
"\\`ad-Orig-"
"\\`menu-bar"
"\\`kill-emacs\\'"
amx-command-marked-ignored-p
amx-command-obsolete-p
amx-command-mouse-interactive-p)
@@ -622,7 +622,7 @@ May not work for things like ido and ivy."
(cl-defun amx-completing-read-helm (choices &key initial-input predicate def)
"Amx backend for helm completion."
(require 'helm-config)
(require 'helm)
(require 'helm-mode) ; Provides `helm-comp-read-map'
(helm-comp-read (amx-prompt-with-prefix-arg) choices
:initial-input initial-input
@@ -630,7 +630,7 @@ May not work for things like ido and ivy."
:default def
:name "Helm M-x Completions"
:buffer "Helm M-x Completions"
:history extended-command-history
:history 'extended-command-history
:reverse-history t
:must-match t
:fuzzy (or (bound-and-true-p helm-mode-fuzzy-match)
@@ -675,17 +675,18 @@ May not work for things like ido and ivy."
:auto-activate '(bound-and-true-p selectrum-mode))
(defsubst amx-auto-select-backend ()
(cl-loop for (bname b) on amx-known-backends by 'cddr
;; Don't auto-select the auto backend, or the
;; default backend.
unless (memq bname '(auto standard))
;; Auto-select a backend if its auto-activate
;; condition evaluates to non-nil.
if (ignore-errors (eval (amx-backend-auto-activate b)))
return b
;; If no backend's auto-activate condition is
;; fulfilled, auto-select the standard backend.
finally return 'standard))
(cl-loop
for (bname b) on amx-known-backends by 'cddr
;; Don't auto-select the auto backend, or the
;; default backend.
unless (memq bname '(auto standard))
;; Auto-select a backend if its auto-activate
;; condition evaluates to non-nil.
if (ignore-errors (eval (amx-backend-auto-activate b)))
return b
;; If no backend's auto-activate condition is
;; fulfilled, auto-select the standard backend.
finally return 'standard))
(cl-defun amx-completing-read-auto (choices &key initial-input predicate def)
"Automatically select the appropriate completion system for M-x.
@@ -771,10 +772,10 @@ This should be the name of backend defined using
;; This speeds up sorting.
(let (new-commands)
(mapatoms (lambda (symbol)
(when (commandp symbol)
(let ((known-command (assq symbol amx-data)))
(if known-command
(setq amx-cache (cons known-command amx-cache))
(let ((known-command (assq symbol amx-data)))
(if known-command
(setq amx-cache (cons known-command amx-cache))
(when (commandp symbol)
(setq new-commands (cons (list symbol) new-commands)))))))
(if (eq (length amx-cache) 0)
(setq amx-cache new-commands)
@@ -836,8 +837,8 @@ Otherwise, if optional arg COUNT-COMMANDS is non-nil, count the
total number of defined commands in `obarray' and update if it
has changed."
(if (or (null amx-last-update-time)
(and count-commands
(amx-detect-new-commands)))
(and count-commands
(amx-detect-new-commands)))
(amx-update)
(amx--debug-message "No update needed at this time.")))
@@ -848,8 +849,8 @@ has changed."
This function is normally idempotent, only having an effect the
first time it is called, so it is safe to call it at the
beginning of any function that expects amx to be initialized.
However, optional arg REINIT forces the initialization needs to
be re-run. Interactively, reinitialize when a prefix arg is
However, optional arg REINIT forces the initialization to be
re-run. Interactively, reinitialize when a prefix arg is
provided."
(interactive "P")
(when (or reinit (not amx-initialized))
@@ -1350,7 +1351,7 @@ current."
(when amx-short-idle-update-timer
(cancel-timer amx-short-idle-update-timer))
(setq amx-short-idle-update-timer
(run-with-idle-timer 1 t 'amx-idle-update)))
(run-with-idle-timer 1 t 'amx-idle-update)))
(provide 'amx)
;;; amx.el ends here

View File

@@ -1,14 +1,14 @@
(define-package "anaconda-mode" "20220922.741" "Code navigation, documentation lookup and completion for Python"
'((emacs "25.1")
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "anaconda-mode" "20250430.227"
"Code navigation, documentation lookup and completion for Python."
'((emacs "25.1")
(pythonic "0.1.0")
(dash "2.6.0")
(s "1.9")
(f "0.16.2"))
:commit "ca8edbaa7662d97e4a4416ec9a8d743863303911" :authors
'(("Artem Malyshev" . "proofit404@gmail.com"))
:maintainer
'("Artem Malyshev" . "proofit404@gmail.com")
:url "https://github.com/proofit404/anaconda-mode")
;; Local Variables:
;; no-byte-compile: t
;; End:
(dash "2.6.0")
(s "1.9")
(f "0.16.2"))
:url "https://github.com/proofit404/anaconda-mode"
:commit "ee1562c6b443be9208910c700e229824b2f1af7a"
:revdesc "ee1562c6b443"
:keywords '("convenience" "anaconda")
:authors '(("Artem Malyshev" . "proofit404@gmail.com"))
:maintainers '(("Artem Malyshev" . "proofit404@gmail.com")))

View File

@@ -4,8 +4,10 @@
;; Author: Artem Malyshev <proofit404@gmail.com>
;; URL: https://github.com/proofit404/anaconda-mode
;; Version: 0.1.15
;; Package-Version: 20250430.227
;; Package-Revision: ee1562c6b443
;; Package-Requires: ((emacs "25.1") (pythonic "0.1.0") (dash "2.6.0") (s "1.9") (f "0.16.2"))
;; Keywords: convenience anaconda
;; 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
@@ -28,6 +30,7 @@
(require 'ansi-color)
(require 'pythonic)
(require 'cl-lib)
(require 'tramp)
(require 'xref)
(require 'json)
@@ -77,6 +80,13 @@
"Time in seconds `anaconda-mode' waits for a synchronous response."
:type 'integer)
; create a defcustom that only allows for 'never, 'always, or 'remote
(defcustom anaconda-mode-disable-rpc 'never
"Disable RPC calls to the `anaconda-mode' server when remote."
:type '(choice (const :tag "Never" never)
(const :tag "Always" always)
(const :tag "Remote" remote)))
;;; Compatibility
;; Functions from posframe which is an optional dependency
@@ -85,7 +95,7 @@
(declare-function posframe-show "posframe")
;;; Server.
(defvar anaconda-mode-server-version "0.1.15"
(defvar anaconda-mode-server-version "0.1.17"
"Server version needed to run `anaconda-mode'.")
(defvar anaconda-mode-process-name "anaconda-mode"
@@ -361,8 +371,11 @@ called when `anaconda-mode-port' will be bound."
(defun anaconda-mode-call (command callback)
"Make remote procedure call for COMMAND.
Apply CALLBACK to the result asynchronously."
(anaconda-mode-start
(lambda () (anaconda-mode-jsonrpc command callback))))
(unless (or (eq anaconda-mode-disable-rpc 'always)
(and (eq anaconda-mode-disable-rpc 'remote)
(pythonic-remote-p)))
(anaconda-mode-start
(lambda () (anaconda-mode-jsonrpc command callback)))))
(defun anaconda-mode-call-sync (command callback)
"Make remote procedure call for COMMAND.
@@ -699,26 +712,29 @@ Show ERROR-MESSAGE if result is empty."
;;; Eldoc.
(defun anaconda-mode-eldoc-function ()
(defun anaconda-mode-eldoc-function (callback &rest _ignored)
"Show eldoc for context at point."
(anaconda-mode-call "eldoc" 'anaconda-mode-eldoc-callback)
(anaconda-mode-call
"eldoc"
(lambda (x)
(funcall callback (anaconda-mode-eldoc-format x))))
;; Don't show response buffer name as ElDoc message.
nil)
(defun anaconda-mode-eldoc-callback (result)
"Display eldoc from server RESULT."
(eldoc-message (anaconda-mode-eldoc-format result)))
(defun anaconda-mode-eldoc-format (result)
"Format eldoc string from RESULT."
(when result
(let ((doc (anaconda-mode-eldoc-format-definition
(aref result 0)
(aref result 1)
(aref result 2))))
(let ((doc (cl-map 'list
(lambda (s)
(anaconda-mode-eldoc-format-definition
(aref s 0)
(aref s 1)
(aref s 2)))
result)))
(if anaconda-mode-eldoc-as-single-line
(substring doc 0 (min (frame-width) (length doc)))
doc))))
(let ((d (mapconcat #'identity doc ", ")))
(substring d 0 (min (frame-width) (length d))))
(mapconcat #'identity doc "\n")))))
(defun anaconda-mode-eldoc-format-definition (name index params)
"Format function definition from NAME, INDEX and PARAMS."
@@ -768,14 +784,15 @@ Show ERROR-MESSAGE if result is empty."
(defun turn-on-anaconda-eldoc-mode ()
"Turn on `anaconda-eldoc-mode'."
(make-local-variable 'eldoc-documentation-function)
(setq-local eldoc-documentation-function 'anaconda-mode-eldoc-function)
(eldoc-mode +1))
(add-hook 'eldoc-documentation-functions
#'anaconda-mode-eldoc-function nil 't)
(unless (bound-and-true-p eldoc-mode)
(eldoc-mode +1)))
(defun turn-off-anaconda-eldoc-mode ()
"Turn off `anaconda-eldoc-mode'."
(kill-local-variable 'eldoc-documentation-function)
(eldoc-mode -1))
(remove-hook 'eldoc-documentation-functions
#'anaconda-mode-eldoc-function 't))
(provide 'anaconda-mode)

View File

@@ -1,4 +1,3 @@
from __future__ import print_function
import sys
import os
@@ -25,7 +24,7 @@ if IS_PY2:
jedi_dep = ('jedi', '0.17.2')
server_directory += '-py2'
else:
jedi_dep = ('jedi', '0.18.1')
jedi_dep = ('jedi', '0.19.2')
server_directory += '-py3'
service_factory_dep = ('service_factory', '0.1.6')
@@ -71,10 +70,20 @@ def install_deps_setuptools():
instrument_installation()
def install_deps_pip():
import pathlib
import shutil
import subprocess
cmd = [sys.executable, '-m', 'pip', 'install', '--target', server_directory]
import tempfile
import venv
temp_dir = pathlib.Path(tempfile.mkdtemp())
venv.create(temp_dir, with_pip=True)
binname = 'Scripts' if sys.platform == 'win32' else 'bin'
cmd = [temp_dir / binname / 'pip', 'install', '--target', server_directory]
cmd.extend(missing_dependencies)
subprocess.check_call(cmd)
try:
subprocess.check_call(cmd)
finally:
shutil.rmtree(temp_dir)
instrument_installation()
if missing_dependencies:
@@ -192,11 +201,11 @@ def get_references(script, line, column):
@script_method
def eldoc(script, line, column):
signatures = script.get_signatures(line, column)
if len(signatures) == 1:
signature = signatures[0]
return [signature.name,
signature.index,
[param.description[6:] for param in signature.params]]
if len(signatures) >= 1:
return [(s.name,
s.index,
[param.description[6:] for param in s.params])
for s in signatures]
# Run.

View File

@@ -0,0 +1,12 @@
(define-package "anaphora" "20240120.1744" "anaphoric macros providing implicit temp variables" 'nil :commit "a755afa7db7f3fa515f8dd2c0518113be0b027f6" :authors
'(("Roland Walker" . "walker@pobox.com"))
:maintainers
'(("Roland Walker" . "walker@pobox.com"))
:maintainer
'("Roland Walker" . "walker@pobox.com")
:keywords
'("extensions")
:url "http://github.com/rolandwalker/anaphora")
;; Local Variables:
;; no-byte-compile: t
;; End:

474
lisp/anaphora/anaphora.el Normal file
View File

@@ -0,0 +1,474 @@
;;; anaphora.el --- anaphoric macros providing implicit temp variables -*- lexical-binding: t -*-
;;
;; This code is in the public domain.
;;
;; Author: Roland Walker <walker@pobox.com>
;; Homepage: http://github.com/rolandwalker/anaphora
;; URL: http://raw.githubusercontent.com/rolandwalker/anaphora/master/anaphora.el
;; Version: 1.0.4
;; Last-Updated: 18 Jun 2018
;; EmacsWiki: Anaphora
;; Keywords: extensions
;;
;;; Commentary:
;;
;; Quickstart
;;
;; (require 'anaphora)
;;
;; (awhen (big-long-calculation)
;; (foo it) ; `it' is provided as
;; (bar it)) ; a temporary variable
;;
;; ;; anonymous function to compute factorial using `self'
;; (alambda (x) (if (= x 0) 1 (* x (self (1- x)))))
;;
;; ;; to fontify `it' and `self'
;; (with-eval-after-load "lisp-mode"
;; (anaphora-install-font-lock-keywords))
;;
;; Explanation
;;
;; Anaphoric expressions implicitly create one or more temporary
;; variables which can be referred to during the expression. This
;; technique can improve clarity in certain cases. It also enables
;; recursion for anonymous functions.
;;
;; To use anaphora, place the anaphora.el library somewhere
;; Emacs can find it, and add the following to your ~/.emacs file:
;;
;; (require 'anaphora)
;;
;; The following macros are made available
;;
;; `aand'
;; `ablock'
;; `acase'
;; `acond'
;; `aecase'
;; `aetypecase'
;; `apcase'
;; `aif'
;; `alambda'
;; `alet'
;; `aprog1'
;; `aprog2'
;; `atypecase'
;; `awhen'
;; `awhile'
;; `a+'
;; `a-'
;; `a*'
;; `a/'
;;
;; See Also
;;
;; M-x customize-group RET anaphora RET
;; http://en.wikipedia.org/wiki/On_Lisp
;; http://en.wikipedia.org/wiki/Anaphoric_macro
;;
;; Notes
;;
;; Partially based on examples from the book "On Lisp", by Paul
;; Graham.
;;
;; Compatibility and Requirements
;;
;; GNU Emacs version 26.1 : yes
;; GNU Emacs version 25.x : yes
;; GNU Emacs version 24.x : yes
;; GNU Emacs version 23.x : yes
;; GNU Emacs version 22.x : yes
;; GNU Emacs version 21.x and lower : unknown
;;
;; Bugs
;;
;; TODO
;;
;; better face for it and self
;;
;;; License
;;
;; All code contributed by the author to this library is placed in the
;; public domain. It is the author's belief that the portions adapted
;; from examples in "On Lisp" are in the public domain.
;;
;; Regardless of the copyright status of individual functions, all
;; code herein is free software, and is provided without any express
;; or implied warranties.
;;
;;; Code:
;;
;;; requirements
;; for declare, labels, do, block, case, ecase, typecase, etypecase
(require 'cl-lib)
;;; customizable variables
;;;###autoload
(defgroup anaphora nil
"Anaphoric macros providing implicit temp variables"
:version "1.0.4"
:link '(emacs-commentary-link :tag "Commentary" "anaphora")
:link '(url-link :tag "GitHub" "http://github.com/rolandwalker/anaphora")
:link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/Anaphora")
:prefix "anaphora-"
:group 'extensions)
;;;###autoload
(defcustom anaphora-use-long-names-only nil
"Use only long names such as `anaphoric-if' instead of traditional `aif'."
:type 'boolean
:group 'anaphora)
;;; font-lock
(defun anaphora-install-font-lock-keywords nil
"Fontify keywords `it' and `self'."
(font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt '("it" "self") 'paren) "\\>")
1 font-lock-variable-name-face)) 'append))
;;; aliases
;;;###autoload
(progn
(defun anaphora--install-traditional-aliases (&optional arg)
"Install traditional short aliases for anaphoric macros.
With negative numeric ARG, remove traditional aliases."
(let ((syms '(
(if . t)
(prog1 . t)
(prog2 . t)
(when . when)
(while . t)
(and . t)
(cond . cond)
(lambda . lambda)
(block . block)
(case . case)
(ecase . ecase)
(typecase . typecase)
(etypecase . etypecase)
(pcase . pcase)
(let . let)
(+ . t)
(- . t)
(* . t)
(/ . t)
)))
(cond
((and (numberp arg)
(< arg 0))
(dolist (cell syms)
(when (ignore-errors
(eq (symbol-function (intern-soft (format "a%s" (car cell))))
(intern-soft (format "anaphoric-%s" (car cell)))))
(fmakunbound (intern (format "a%s" (car cell)))))))
(t
(dolist (cell syms)
(let* ((builtin (car cell))
(traditional (intern (format "a%s" builtin)))
(long (intern (format "anaphoric-%s" builtin))))
(defalias traditional long)
(put traditional 'lisp-indent-function
(get builtin 'lisp-indent-function))
(put traditional 'edebug-form-spec (cdr cell)))))))))
;;;###autoload
(unless anaphora-use-long-names-only
(anaphora--install-traditional-aliases))
;;; macros
;;;###autoload
(defmacro anaphoric-if (cond then &rest else)
"Like `if', but the result of evaluating COND is bound to `it'.
The variable `it' is available within THEN and ELSE.
COND, THEN, and ELSE are otherwise as documented for `if'."
(declare (debug t)
(indent 2))
`(let ((it ,cond))
(if it ,then ,@else)))
;;;###autoload
(defmacro anaphoric-prog1 (first &rest body)
"Like `prog1', but the result of evaluating FIRST is bound to `it'.
The variable `it' is available within BODY.
FIRST and BODY are otherwise as documented for `prog1'."
(declare (debug t)
(indent 1))
`(let ((it ,first))
(progn ,@body)
it))
;;;###autoload
(defmacro anaphoric-prog2 (form1 form2 &rest body)
"Like `prog2', but the result of evaluating FORM2 is bound to `it'.
The variable `it' is available within BODY.
FORM1, FORM2, and BODY are otherwise as documented for `prog2'."
(declare (debug t)
(indent 2))
`(progn
,form1
(let ((it ,form2))
(progn ,@body)
it)))
;;;###autoload
(defmacro anaphoric-when (cond &rest body)
"Like `when', but the result of evaluating COND is bound to `it'.
The variable `it' is available within BODY.
COND and BODY are otherwise as documented for `when'."
(declare (debug when)
(indent 1))
`(anaphoric-if ,cond
(progn ,@body)))
;;;###autoload
(defmacro anaphoric-while (test &rest body)
"Like `while', but the result of evaluating TEST is bound to `it'.
The variable `it' is available within BODY.
TEST and BODY are otherwise as documented for `while'."
(declare (debug t)
(indent 1))
`(do ((it ,test ,test))
((not it))
,@body))
;;;###autoload
(defmacro anaphoric-and (&rest conditions)
"Like `and', but the result of the previous condition is bound to `it'.
The variable `it' is available within all CONDITIONS after the
initial one.
CONDITIONS are otherwise as documented for `and'.
Note that some implementations of this macro bind only the first
condition to `it', rather than each successive condition."
(declare (debug t))
(cond
((null conditions)
t)
((null (cdr conditions))
(car conditions))
(t
`(anaphoric-if ,(car conditions) (anaphoric-and ,@(cdr conditions))))))
;;;###autoload
(defmacro anaphoric-cond (&rest clauses)
"Like `cond', but the result of each condition is bound to `it'.
The variable `it' is available within the remainder of each of CLAUSES.
CLAUSES are otherwise as documented for `cond'."
(declare (debug cond))
(if (null clauses)
nil
(let ((cl1 (car clauses))
(sym (gensym)))
`(let ((,sym ,(car cl1)))
(if ,sym
(if (null ',(cdr cl1))
,sym
(let ((it ,sym)) ,@(cdr cl1)))
(anaphoric-cond ,@(cdr clauses)))))))
;;;###autoload
(defmacro anaphoric-lambda (args &rest body)
"Like `lambda', but the function may refer to itself as `self'.
ARGS and BODY are otherwise as documented for `lambda'."
(declare (debug lambda)
(indent defun))
`(cl-labels ((self ,args ,@body))
#'self))
;;;###autoload
(defmacro anaphoric-block (name &rest body)
"Like `block', but the result of the previous expression is bound to `it'.
The variable `it' is available within all expressions of BODY
except the initial one.
NAME and BODY are otherwise as documented for `block'."
(declare (debug block)
(indent 1))
`(cl-block ,name
,(funcall (anaphoric-lambda (body)
(cl-case (length body)
(0 nil)
(1 (car body))
(t `(let ((it ,(car body)))
,(self (cdr body))))))
body)))
;;;###autoload
(defmacro anaphoric-case (expr &rest clauses)
"Like `case', but the result of evaluating EXPR is bound to `it'.
The variable `it' is available within CLAUSES.
EXPR and CLAUSES are otherwise as documented for `case'."
(declare (debug case)
(indent 1))
`(let ((it ,expr))
(cl-case it ,@clauses)))
;;;###autoload
(defmacro anaphoric-ecase (expr &rest clauses)
"Like `ecase', but the result of evaluating EXPR is bound to `it'.
The variable `it' is available within CLAUSES.
EXPR and CLAUSES are otherwise as documented for `ecase'."
(declare (debug ecase)
(indent 1))
`(let ((it ,expr))
(cl-ecase it ,@clauses)))
;;;###autoload
(defmacro anaphoric-typecase (expr &rest clauses)
"Like `typecase', but the result of evaluating EXPR is bound to `it'.
The variable `it' is available within CLAUSES.
EXPR and CLAUSES are otherwise as documented for `typecase'."
(declare (debug typecase)
(indent 1))
`(let ((it ,expr))
(cl-typecase it ,@clauses)))
;;;###autoload
(defmacro anaphoric-etypecase (expr &rest clauses)
"Like `etypecase', but result of evaluating EXPR is bound to `it'.
The variable `it' is available within CLAUSES.
EXPR and CLAUSES are otherwise as documented for `etypecase'."
(declare (debug etypecase)
(indent 1))
`(let ((it ,expr))
(cl-etypecase it ,@clauses)))
;;;###autoload
(defmacro anaphoric-pcase (expr &rest clauses)
"Like `pcase', but the result of evaluating EXPR is bound to `it'.
The variable `it' is available within CLAUSES.
EXPR and CLAUSES are otherwise as documented for `pcase'."
(declare (debug pcase)
(indent 1))
`(let ((it ,expr))
(pcase it ,@clauses)))
;;;###autoload
(defmacro anaphoric-let (form &rest body)
"Like `let', but the result of evaluating FORM is bound to `it'.
FORM and BODY are otherwise as documented for `let'."
(declare (debug let)
(indent 1))
`(let ((it ,form))
(progn ,@body)))
;;;###autoload
(defmacro anaphoric-+ (&rest numbers-or-markers)
"Like `+', but the result of evaluating the previous expression is bound to `it'.
The variable `it' is available within all expressions after the
initial one.
NUMBERS-OR-MARKERS are otherwise as documented for `+'."
(declare (debug t))
(cond
((null numbers-or-markers)
0)
(t
`(let ((it ,(car numbers-or-markers)))
(+ it (anaphoric-+ ,@(cdr numbers-or-markers)))))))
;;;###autoload
(defmacro anaphoric-- (&optional number-or-marker &rest numbers-or-markers)
"Like `-', but the result of evaluating the previous expression is bound to `it'.
The variable `it' is available within all expressions after the
initial one.
NUMBER-OR-MARKER and NUMBERS-OR-MARKERS are otherwise as
documented for `-'."
(declare (debug t))
(cond
((null number-or-marker)
0)
((null numbers-or-markers)
`(- ,number-or-marker))
(t
`(let ((it ,(car numbers-or-markers)))
(- ,number-or-marker (+ it (anaphoric-+ ,@(cdr numbers-or-markers))))))))
;;;###autoload
(defmacro anaphoric-* (&rest numbers-or-markers)
"Like `*', but the result of evaluating the previous expression is bound to `it'.
The variable `it' is available within all expressions after the
initial one.
NUMBERS-OR-MARKERS are otherwise as documented for `*'."
(declare (debug t))
(cond
((null numbers-or-markers)
1)
(t
`(let ((it ,(car numbers-or-markers)))
(* it (anaphoric-* ,@(cdr numbers-or-markers)))))))
;;;###autoload
(defmacro anaphoric-/ (dividend divisor &rest divisors)
"Like `/', but the result of evaluating the previous divisor is bound to `it'.
The variable `it' is available within all expressions after the
first divisor.
DIVIDEND, DIVISOR, and DIVISORS are otherwise as documented for `/'."
(declare (debug t))
(cond
((null divisors)
`(/ ,dividend ,divisor))
(t
`(let ((it ,divisor))
(/ ,dividend (* it (anaphoric-* ,@divisors)))))))
(provide 'anaphora)
;;
;; Emacs
;;
;; Local Variables:
;; indent-tabs-mode: nil
;; mangle-whitespace: t
;; require-final-newline: t
;; coding: utf-8
;; byte-compile-warnings: (not cl-functions redefine)
;; End:
;;
;; LocalWords: Anaphora EXPR awhen COND ARGS alambda ecase typecase
;; LocalWords: etypecase aprog aand acond ablock acase aecase alet
;; LocalWords: atypecase aetypecase apcase
;;
;;; anaphora.el ends here

View File

@@ -6,7 +6,7 @@
;; Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async byte-compile
;; X-URL: https://github.com/jwiegley/dired-async
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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
@@ -22,17 +22,22 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This package provide the `async-byte-recompile-directory' function
;; which allows, as the name says to recompile a directory outside of
;; your running emacs.
;; The benefit is your files will be compiled in a clean environment without
;; the old *.el files loaded.
;; Among other things, this fix a bug in package.el which recompile
;; the new files in the current environment with the old files loaded, creating
;; errors in most packages after upgrades.
;; your running emacs. Single files can be compiled with
;; `async-byte-compile-file'. The benefit is your files will be
;; compiled in a clean environment without the old *.el files
;; loaded. A mode `async-bytecomp-package-mode' is provided to
;; automatically compile packages asynchronously when installing or
;; upgrading, among other things, this fix a bug in package.el which
;; recompile the new files in the current environment with the old
;; files loaded, creating errors in most packages after upgrades.
;;
;; NB: This package is advicing the function `package--compile'.
;; NB: This package is advising the function `package--compile' when
;; `async-bytecomp-package-mode' is enabled. This mode is useful
;; only when using a synchronous package manager (e.g. M-x
;; list-package), users of M-x helm-packages don't need this anymore.
;;; Code:
@@ -60,6 +65,33 @@ all packages are always compiled asynchronously."
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.")
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
(let ((bn (file-name-nondirectory (directory-file-name file-or-dir)))
(action-name (pcase type
('file "File")
('directory "Directory"))))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n bn)
(message "%s `%s' compiled asynchronously with warnings"
action-name bn)))))
(unless quiet
(message "%s `%s' compiled asynchronously with success" action-name bn)))))
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
@@ -73,26 +105,7 @@ All *.elc files are systematically deleted before proceeding."
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
(unless quiet
(message "Directory `%s' compiled asynchronously with success" directory))))))
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
(async-start
`(lambda ()
(require 'bytecomp)
@@ -140,13 +153,10 @@ All *.elc files are systematically deleted before proceeding."
(memq cur-package (async-bytecomp--get-package-deps
async-bytecomp-allowed-packages)))
(progn
;; FIXME: Why do we use (eq cur-package 'async) once
;; and (string= cur-package "async") afterwards?
(when (eq cur-package 'async)
(fmakunbound 'async-byte-recompile-directory))
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(when (string= cur-package "async")
(fmakunbound 'async-byte-recompile-directory)
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(cl-pushnew pkg-dir load-path)
(load "async-bytecomp"))
;; `async-byte-recompile-directory' will add directory
@@ -158,7 +168,10 @@ All *.elc files are systematically deleted before proceeding."
(define-minor-mode async-bytecomp-package-mode
"Byte compile asynchronously packages installed with package.el.
Async compilation of packages can be controlled by
`async-bytecomp-allowed-packages'."
`async-bytecomp-allowed-packages'.
NOTE: Use this mode only if you install/upgrade etc... your packages
synchronously, if you use a package manager like helm-package.el which
by default is async you don't need this."
:group 'async
:global t
(if async-bytecomp-package-mode
@@ -173,28 +186,13 @@ Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ")
(let ((call-back
(lambda (&optional _ignore)
(let ((bn (file-name-nondirectory file)))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
start)
(with-current-buffer buf
(goto-char (setq start (point-max)))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(save-excursion
(goto-char start)
(if (re-search-forward "^.*:Error:" nil t)
(message "Failed to compile `%s'" bn)
(message "`%s' compiled asynchronously with warnings" bn)))))
(message "`%s' compiled asynchronously with success" bn))))))
(async-bytecomp--file-to-comp-buffer file nil 'file))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file)))
(let ((default-directory ,(file-name-directory file))
error-data)
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)

145
lisp/async/async-package.el Normal file
View File

@@ -0,0 +1,145 @@
;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
;; Author: Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async byte-compile package
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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/>.
;;; Commentary:
;; Provide the function `async-package-do-action' to
;; (re)install/upgrade packages asynchronously.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'async-bytecomp)
(require 'dired-async)
(require 'package)
(define-minor-mode async-package--modeline-mode
"Notify mode-line that an async process run."
:group 'async
:global t
:lighter (:eval (propertize (format " [%s async job Installing package(s)]"
(length (dired-async-processes
'async-pkg-install)))
'face 'async-package-message))
(unless async-package--modeline-mode
(let ((visible-bell t)) (ding))))
(defvar async-pkg-install-after-hook nil
"Hook that run after package installation.
The hook runs in the call-back once installation is done in child emacs.")
(defface async-package-message
'((t (:foreground "yellow")))
"Face used for mode-line message."
:group 'async)
(defun async-package-do-action (action packages error-file)
"Execute ACTION asynchronously on PACKAGES.
Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
Argument PACKAGES is a list of packages (symbols).
Argument ERROR-FILE is the file where errors are logged, if some."
(require 'async-bytecomp)
(let ((fn (pcase action
('install 'package-install)
('upgrade 'package-upgrade)
('reinstall 'package-reinstall)))
(action-string (pcase action
('install "Installing")
('upgrade "Upgrading")
('reinstall "Reinstalling"))))
(message "%s %s package(s)..." action-string (length packages))
(process-put
(async-start
`(lambda ()
(require 'bytecomp)
(setq package-archives ',package-archives
package-pinned-packages ',package-pinned-packages
package-archive-contents ',package-archive-contents
package-user-dir ,package-user-dir
package-alist ',package-alist
load-path ',load-path)
;; Ensure `async-bytecomp-package-mode' doesn't kick in
;; (issue #194) as some packages may enable it
;; inconditionally. We don't need to compile async as we are
;; already async and in a clean environment.
(require 'async-bytecomp)
(setq async-bytecomp-allowed-packages nil)
(prog1
(condition-case err
(mapc ',fn ',packages)
(error
(with-temp-file ,error-file
(insert
(format
"%S:\n Please refresh package list before %s"
err ,action-string)))))
(let (error-data)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties
(point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data)))))))
(lambda (result)
(if (file-exists-p error-file)
(let ((buf (find-file-noselect error-file)))
(pop-to-buffer
buf '(nil . ((window-height . fit-window-to-buffer))))
(special-mode)
(delete-file error-file)
(async-package--modeline-mode -1))
(when result
(let ((pkgs (if (listp result) result (list result))))
(when (eq action 'install)
(customize-save-variable
'package-selected-packages
(delete-dups (append pkgs package-selected-packages))))
(package-load-all-descriptors) ; refresh package-alist.
(mapc #'package-activate pkgs) ; load packages.
(async-package--modeline-mode -1)
(message "%s %s packages done" action-string (length packages))
(run-with-timer
0.1 nil
(lambda (lst str)
(dired-async-mode-line-message
"%s %d package(s) done"
'async-package-message
str (length lst)))
packages action-string)
(when (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)))))))
(run-hooks 'async-pkg-install-after-hook)))
'async-pkg-install t)
(async-package--modeline-mode 1)))
(provide 'async-package)
;;; async-package.el ends here

View File

@@ -1,12 +1,10 @@
(define-package "async" "20221217.649" "Asynchronous processing in Emacs"
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "async" "20250325.509"
"Asynchronous processing in Emacs."
'((emacs "24.4"))
:commit "c4772bec684776e93f1b8d845b452dc850ee2315" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainer
'("Thierry Volpiatto" . "thievol@posteo.net")
:keywords
'("async")
:url "https://github.com/jwiegley/emacs-async")
;; Local Variables:
;; no-byte-compile: t
;; End:
:url "https://github.com/jwiegley/emacs-async"
:commit "bb3f31966ed65a76abe6fa4f80a960a2917f554e"
:revdesc "bb3f31966ed6"
:keywords '("async")
:authors '(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers '(("Thierry Volpiatto" . "thievol@posteo.net")))

View File

@@ -6,7 +6,8 @@
;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
;; Created: 18 Jun 2012
;; Version: 1.9.7
;; Package-Version: 20250325.509
;; Package-Revision: bb3f31966ed6
;; Package-Requires: ((emacs "24.4"))
;; Keywords: async
@@ -34,6 +35,8 @@
(eval-when-compile (require 'cl-lib))
(defvar tramp-password-prompt-regexp)
(defgroup async nil
"Simple asynchronous processing in Emacs"
:group 'lisp)
@@ -42,15 +45,34 @@
"Default function to remove text properties in variables."
:type 'function)
(defcustom async-prompt-for-password t
"Prompt for password in parent Emacs if needed when non nil.
When this is nil child Emacs will hang forever when a user interaction
for password is required unless a password is stored in a \".authinfo\" file."
:type 'boolean)
(defvar async-process-noquery-on-exit nil
"Used as the :noquery argument to `make-process'.
Intended to be let-bound around a call to `async-start' or
`async-start-process'. If non-nil, the child Emacs process will
be silently killed if the user exits the parent Emacs.")
(defvar async-debug nil)
(defvar async-send-over-pipe t)
(defvar async-in-child-emacs nil)
(defvar async-callback nil)
(defvar async-callback-for-process nil)
(defvar async-callback-for-process nil
"Non-nil if the subprocess is not Emacs executing a lisp form.")
(defvar async-callback-value nil)
(defvar async-callback-value-set nil)
(defvar async-current-process nil)
(defvar async--procvar nil)
(defvar async-read-marker nil
"Position from which we read the last message packet.
Message packets are delivered from client line-by-line as base64
encoded strings.")
(defvar async-child-init nil
"Initialisation file for async child Emacs.
@@ -96,14 +118,17 @@ is returned unmodified."
collect elm))
(t object)))
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
"A list of regexps that `async-inject-variables' should ignore.")
(defun async-inject-variables
(include-regexp &optional predicate exclude-regexp noprops)
"Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE. It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
i.e. ending by \"-syntax-table\".
matching EXCLUDE-REGEXP (if present) and variables matching one of
`async-inject-variables-exclude-regexps'.
When NOPROPS is non nil it tries to strip out text properties of each
variable's value with `async-variables-noprops-function'.
@@ -122,14 +147,16 @@ It is intended to be used as follows:
,@(let (bindings)
(mapatoms
(lambda (sym)
(let* ((sname (and (boundp sym) (symbol-name sym)))
(value (and sname (symbol-value sym))))
(let ((sname (and (boundp sym) (symbol-name sym)))
value)
(when (and sname
(or (null include-regexp)
(string-match include-regexp sname))
(or (null exclude-regexp)
(not (string-match exclude-regexp sname)))
(not (string-match "-syntax-table\\'" sname)))
(cl-loop for re in async-inject-variables-exclude-regexps
never (string-match-p re sname)))
(setq value (symbol-value sym))
(unless (or (stringp value)
(memq value '(nil t))
(numberp value)
@@ -171,12 +198,16 @@ It is intended to be used as follows:
(prog1
(funcall async-callback proc)
(unless async-debug
(kill-buffer (current-buffer))))
;; we need to check this because theoretically
;; `async-callback' could've killed it already
(when (buffer-live-p (process-buffer proc))
(kill-buffer (process-buffer proc)))))
(set (make-local-variable 'async-callback-value) proc)
(set (make-local-variable 'async-callback-value-set) t))
;; Maybe strip out unreadable "#"; They are replaced by
;; empty string unless they are prefixing a special
;; object like a marker. See issue #145.
(widen)
(goto-char (point-min))
(save-excursion
;; Transform markers in list like
@@ -189,22 +220,80 @@ It is intended to be used as follows:
(replace-match "(" t t))
(goto-char (point-max))
(backward-sexp)
(async-handle-result async-callback (read (current-buffer))
(current-buffer)))
(let ((value (read (current-buffer))))
(async-handle-result async-callback value (current-buffer))))
(set (make-local-variable 'async-callback-value)
(list 'error
(format "Async process '%s' failed with exit code %d"
(process-name proc) (process-exit-status proc))))
(set (make-local-variable 'async-callback-value-set) t))))))
(defun async-read-from-client (proc string &optional prompt-for-pwd)
"Process text from client process.
The string chunks usually arrive in maximum of 4096 bytes, so a
long client message might be split into multiple calls of this
function.
We use a marker `async-read-marker' to track the position of the
lasts complete line. Every time we get new input, we try to look
for newline, and if found, process the entire line and bump the
marker position to the end of this next line.
Argument PROMPT-FOR-PWD allow binding lexically the value of
`async-prompt-for-password', if unspecified its global value
is used."
(with-current-buffer (process-buffer proc)
(when (and prompt-for-pwd
(boundp 'tramp-password-prompt-regexp)
tramp-password-prompt-regexp
(string-match tramp-password-prompt-regexp string))
(process-send-string
proc (concat (read-passwd (match-string 0 string)) "\n")))
(goto-char (point-max))
(save-excursion
(insert string))
(while (search-forward "\n" nil t)
(save-excursion
(save-restriction
(widen)
(narrow-to-region async-read-marker (point))
(goto-char (point-min))
(let (msg)
(condition-case nil
;; It is safe to throw errors in the read because we
;; send messages always on their own line, and they
;; are always a base64 encoded string, so a message
;; will always read. We will also ignore the rest
;; of this line since there won't be anything
;; interesting.
(while (setq msg (read (current-buffer)))
(let ((msg-decoded (ignore-errors (base64-decode-string msg))))
(when msg-decoded
(setq msg-decoded (car (read-from-string msg-decoded)))
(when (and (listp msg-decoded)
(async-message-p msg-decoded)
async-callback)
(funcall async-callback msg-decoded)))))
;; This is OK, we reached the end of the chunk subprocess sent
;; at this time.
(invalid-read-syntax t)
(end-of-file t)))
(goto-char (point-max))
(move-marker async-read-marker (point)))))))
(defun async--receive-sexp (&optional stream)
;; FIXME: Why use `utf-8-auto' instead of `utf-8-unix'? This is
;; a communication channel over which we have complete control,
;; so we get to choose exactly which encoding and EOL we use, isn't it?
;; so we get to choose exactly which encoding and EOL we use, isn't
;; it?
;; UPDATE: We use now `utf-8-emacs-unix' instead of `utf-8-auto' as
;; recommended in bug#165.
(let ((sexp (decode-coding-string (base64-decode-string (read stream))
'utf-8-auto))
'utf-8-emacs-unix))
;; Parent expects UTF-8 encoded text.
(coding-system-for-write 'utf-8-auto))
(coding-system-for-write 'utf-8-emacs-unix))
(if async-debug
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
(setq sexp (read sexp))
@@ -221,7 +310,7 @@ It is intended to be used as follows:
(print-symbols-bare t))
(prin1 sexp (current-buffer))
;; Just in case the string we're sending might contain EOF
(encode-coding-region (point-min) (point-max) 'utf-8-auto)
(encode-coding-region (point-min) (point-max) 'utf-8-emacs-unix)
(base64-encode-region (point-min) (point-max) t)
(goto-char (point-min)) (insert ?\")
(goto-char (point-max)) (insert ?\" ?\n)))
@@ -237,17 +326,27 @@ It is intended to be used as follows:
"Called from the child Emacs process' command line."
;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
;; process expects.
(let ((coding-system-for-write 'utf-8-auto)
(let ((coding-system-for-write 'utf-8-emacs-unix)
(args-left command-line-args-left))
(setq async-in-child-emacs t
debug-on-error async-debug
command-line-args-left nil)
(condition-case-unless-debug err
(prin1 (funcall
(async--receive-sexp (unless async-send-over-pipe
args-left))))
(let ((ret (funcall
(async--receive-sexp (unless async-send-over-pipe
args-left)))))
;; The newlines makes client messages more robust and also
;; handle some weird line-buffering issues on windows.
;; Sometimes, the last "chunk" was not read by the filter,
;; so a newline here should force a buffer flush.
(princ "\n")
(prin1 ret)
(princ "\n"))
(error
(prin1 (list 'async-signal err))))))
(progn
(princ "\n")
(prin1 (list 'async-signal err))
(princ "\n"))))))
(defun async-ready (future)
"Query a FUTURE to see if it is ready.
@@ -277,20 +376,51 @@ its FINISH-FUNC is nil."
#'identity async-callback-value (current-buffer))))))
(defun async-message-p (value)
"Return non-nil of VALUE is an async.el message packet."
"Return non-nil if VALUE is an async.el message packet."
(and (listp value)
(plist-get value :async-message)))
(defun async-send (&rest args)
"Send the given messages to the asychronous Emacs PROCESS."
(defun async-send (process-or-key &rest args)
"Send the given message to the asynchronous child or parent Emacs.
To send messages from the parent to a child, PROCESS-OR-KEY is
the child process object. ARGS is a plist. Example:
(async-send proc :operation :load-file :file \"this file\")
To send messages from the child to the parent, PROCESS-OR-KEY is
the first key of the plist, ARGS is a value followed by
optionally more key-value pairs. Example:
(async-send :status \"finished\" :file-size 123)"
(let ((args (append args '(:async-message t))))
(if async-in-child-emacs
(if async-callback
(funcall async-callback args))
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
;; `princ' because async--insert-sexp already quotes everything.
(princ
(with-temp-buffer
(async--insert-sexp (cons process-or-key args))
;; always make sure that one message package has its own
;; line as there can be any random debug garbage printed
;; above it.
(concat "\n" (buffer-string))))
(async--transmit-sexp process-or-key (list 'quote args)))))
(defun async-receive ()
"Send the given messages to the asychronous Emacs PROCESS."
"Receive message from parent Emacs.
The child process blocks until a message is received.
Message is a plist with one key :async-message set to t always
automatically added to signify this plist is an async message.
You can use `async-message-p' to test if the payload was a
message.
Use
(let ((msg (async-receive))) ...)
to read and process a message."
(async--receive-sexp))
;;;###autoload
@@ -302,11 +432,31 @@ object will return the process object when the program is
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory."
(let* ((buf (generate-new-buffer (concat "*" name "*")))
(buf-err (generate-new-buffer (concat "*" name ":err*")))
(prt-for-pwd async-prompt-for-password)
(proc (let ((process-connection-type nil))
(apply #'start-process name buf program program-args))))
(make-process
:name name
:buffer buf
:stderr buf-err
:command (cons program program-args)
:noquery async-process-noquery-on-exit))))
(set-process-sentinel
(get-buffer-process buf-err)
(lambda (proc _change)
(unless (or async-debug (process-live-p proc))
(kill-buffer (process-buffer proc)))))
(with-current-buffer buf
(set (make-local-variable 'async-callback) finish-func)
(set (make-local-variable 'async-read-marker)
(set-marker (make-marker) (point-min) buf))
(set-marker-insertion-type async-read-marker nil)
(set-process-sentinel proc #'async-when-done)
;; Pass the value of `async-prompt-for-password' to the process
;; filter fn through the lexical local var prt-for-pwd (Issue#182).
(set-process-filter proc (lambda (proc string)
(async-read-from-client
proc string prt-for-pwd)))
(unless (string= name "emacs")
(set (make-local-variable 'async-callback-for-process) t))
proc)))
@@ -317,11 +467,20 @@ Can be one of \"-Q\" or \"-q\".
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
enhanced config or some more variables loaded.")
(defvar async-library nil
"Cache async library path.
It is useful only when you run multiple async processes in a loop, to
avoid calling many times `locate-library' which is costly.
This variable should be let bound around an `async-start' call and not
used globally. Should be found with `locate-library'.")
(defun async--emacs-program-args (&optional sexp)
"Return a list of arguments for invoking the child Emacs."
;; Using `locate-library' ensure we use the right file
;; when the .elc have been deleted.
(let ((args (list async-quiet-switch "-l" (locate-library "async"))))
;; when the .elc have been deleted, its result can be cached in
;; `async-library' see Issue#193.
(let ((args (list async-quiet-switch "-l" (or async-library
(locate-library "async")))))
(when async-child-init
(setq args (append args (list "-l" async-child-init))))
(append args (list "-batch" "-f" "async-batch-invoke"
@@ -348,6 +507,16 @@ When done, the return value is passed to FINISH-FUNC. Example:
(message \"Async process done, result should be 222: %s\"
result)))
If you call `async-send' from a child process, the message will
be also passed to the FINISH-FUNC. You can test RESULT to see if
it is a message by using `async-message-p'. If nil, it means
this is the final result. Example of the FINISH-FUNC:
(lambda (result)
(if (async-message-p result)
(message \"Received a message from child process: %s\" result)
(message \"Async process done, result: %s\" result)))
If FINISH-FUNC is nil or missing, a future is returned that can
be inspected using `async-get', blocking until the value is
ready. Example:
@@ -392,7 +561,7 @@ returns nil. It can still be useful, however, as an argument to
`async-ready' or `async-wait'."
(let ((sexp start-func)
;; Subordinate Emacs will send text encoded in UTF-8.
(coding-system-for-read 'utf-8-auto))
(coding-system-for-read 'utf-8-emacs-unix))
(setq async--procvar
(apply 'async-start-process
"emacs" (file-truename

View File

@@ -6,7 +6,7 @@
;; Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async network
;; X-URL: https://github.com/jwiegley/dired-async
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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
@@ -81,6 +81,10 @@ or rename for `dired-async-skip-fast'."
:risky t
:type 'integer)
(defcustom dired-async-large-file-warning-threshold large-file-warning-threshold
"Same as `large-file-warning-threshold' but for dired-async."
:type 'integer)
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message.")
@@ -115,9 +119,9 @@ or rename for `dired-async-skip-fast'."
(sit-for 3)
(force-mode-line-update)))
(defun dired-async-processes ()
(defun dired-async-processes (&optional propname)
(cl-loop for p in (process-list)
when (process-get p 'dired-async-process)
when (process-get p (or propname 'dired-async-process))
collect p))
(defun dired-async-kill-process ()
@@ -242,6 +246,14 @@ cases if `dired-async-skip-fast' is non-nil."
(funcall old-func file-creator operation
(nreverse quick-list) name-constructor marker-char))))
(defun dired-async--abort-if-file-too-large (size op-type filename)
"Warn when FILENAME larger than `dired-async-large-file-warning-threshold'.
Same as `abort-if-file-too-large' but without user-error."
(when (and dired-async-large-file-warning-threshold size
(> size dired-async-large-file-warning-threshold))
(files--ask-user-about-large-file
size op-type filename nil)))
(defvar overwrite-query)
(defun dired-async-create-files (file-creator operation fn-list name-constructor
&optional _marker-char)
@@ -251,7 +263,7 @@ See `dired-create-files' for the behavior of arguments."
(setq overwrite-query nil)
(let ((total (length fn-list))
failures async-fn-list skipped callback
async-quiet-switch)
async-quiet-switch create-dir)
(let (to)
(dolist (from fn-list)
(setq to (funcall name-constructor from))
@@ -299,14 +311,22 @@ ESC or `q' to not overwrite any of the remaining files,
(file-in-directory-p destname from)
(error "Cannot copy `%s' into its subdirectory `%s'"
from to)))
(if overwrite
(or (and dired-overwrite-confirmed
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list)))))
;; Skip file if it is too large.
(if (and (member operation '("Copy" "Rename"))
(eq (dired-async--abort-if-file-too-large
(file-attribute-size
(file-attributes (file-truename from)))
(downcase operation) from)
'abort))
(push from skipped)
(if overwrite
(or (and dired-overwrite-confirmed
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list))))))
;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
(setq async-quiet-switch
(if (and (boundp 'tramp-cache-read-persistent-data)
@@ -344,16 +364,31 @@ ESC or `q' to not overwrite any of the remaining files,
for destp = (file-exists-p to)
do (and bf destp
(with-current-buffer bf
(set-visited-file-name to t t))))))))
(set-visited-file-name to t t)))))))
(let ((dirp (file-directory-p to))
(dest (file-name-directory to)))
(when (boundp 'dired-create-destination-dirs)
(setq create-dir
(cl-case dired-create-destination-dirs
(always 'always)
(ask (and (null dirp)
(null (file-directory-p dest))
(y-or-n-p (format "Create directory `%s'? " dest)))
'always))))))
;; Start async process.
(when async-fn-list
(process-put
(async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables dired-async-env-variables-regexp)
(advice-add #'files--ask-user-about-large-file
:override (lambda (&rest args) nil))
(let ((dired-recursive-copies (quote always))
(dired-copy-preserve-time
,dired-copy-preserve-time))
,dired-copy-preserve-time)
(dired-create-destination-dirs ',create-dir)
(dired-vc-rename-file ,dired-vc-rename-file)
auth-source-save-behavior)
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not
;; available in emacs.

11
lisp/avy/avy-pkg.el Normal file
View File

@@ -0,0 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "avy" "20241101.1357"
"Jump to arbitrary positions in visible text and select text quickly."
'((emacs "24.1")
(cl-lib "0.5"))
:url "https://github.com/abo-abo/avy"
:commit "933d1f36cca0f71e4acb5fac707e9ae26c536264"
:revdesc "933d1f36cca0"
:keywords '("point" "location")
:authors '(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainers '(("Oleh Krehel" . "ohwoeowho@gmail.com")))

View File

@@ -4,9 +4,8 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/avy
;; Package-Version: 20220910.1936
;; Package-Commit: 955c8dedd68c74f3cf692c1249513f048518c4c9
;; Version: 0.5.0
;; Package-Version: 20241101.1357
;; Package-Revision: 933d1f36cca0
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; Keywords: point, location
@@ -28,22 +27,22 @@
;;; Commentary:
;;
;; With Avy, you can move point to any position in Emacs even in a
;; different window using very few keystrokes. For this, you look at
;; different window using very few keystrokes. For this, you look at
;; the position where you want point to be, invoke Avy, and then enter
;; the sequence of characters displayed at that position.
;;
;; If the position you want to jump to can be determined after only
;; issuing a single keystroke, point is moved to the desired position
;; immediately after that keystroke. In case this isn't possible, the
;; immediately after that keystroke. In case this isn't possible, the
;; sequence of keystrokes you need to enter is comprised of more than
;; one character. Avy uses a decision tree where each candidate position
;; one character. Avy uses a decision tree where each candidate position
;; is a leaf and each edge is described by a character which is distinct
;; per level of the tree. By entering those characters, you navigate the
;; per level of the tree. By entering those characters, you navigate the
;; tree, quickly arriving at the desired candidate position, such that
;; Avy can move point to it.
;;
;; Note that this only makes sense for positions you are able to see
;; when invoking Avy. These kinds of positions are supported:
;; when invoking Avy. These kinds of positions are supported:
;;
;; * character positions
;; * word or subword start positions
@@ -101,7 +100,7 @@ keys different than the following: a, e, i, o, u, y"
(function :tag "Other command")))
(defcustom avy-keys-alist nil
"Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
"Alist of `avy-jump' commands to `avy-keys' overriding the default `avy-keys'."
:type `(alist
:key-type ,avy--key-type
:value-type (repeat :tag "Keys" character)))
@@ -158,27 +157,27 @@ Use `avy-styles-alist' to customize this per-command."
(const :tag "Words" words)))
(defcustom avy-styles-alist nil
"Alist of avy-jump commands to the style for each command.
"Alist of `avy-jump' commands to the style for each command.
If the commands isn't on the list, `avy-style' is used."
:type '(alist
:key-type (choice :tag "Command"
(const avy-goto-char)
(const avy-goto-char-2)
(const avy-isearch)
(const avy-goto-line)
(const avy-goto-subword-0)
(const avy-goto-subword-1)
(const avy-goto-word-0)
(const avy-goto-word-1)
(const avy-copy-line)
(const avy-copy-region)
(const avy-move-line)
(const avy-move-region)
(const avy-kill-whole-line)
(const avy-kill-region)
(const avy-kill-ring-save-whole-line)
(const avy-kill-ring-save-region)
(function :tag "Other command"))
(const avy-goto-char)
(const avy-goto-char-2)
(const avy-isearch)
(const avy-goto-line)
(const avy-goto-subword-0)
(const avy-goto-subword-1)
(const avy-goto-word-0)
(const avy-goto-word-1)
(const avy-copy-line)
(const avy-copy-region)
(const avy-move-line)
(const avy-move-region)
(const avy-kill-whole-line)
(const avy-kill-region)
(const avy-kill-ring-save-whole-line)
(const avy-kill-ring-save-region)
(function :tag "Other command"))
:value-type (choice
(const :tag "Pre" pre)
(const :tag "At" at)
@@ -397,7 +396,7 @@ SEQ-LEN is how many elements of KEYS it takes to identify a match."
(defvar avy-command nil
"Store the current command symbol.
E.g. 'avy-goto-line or 'avy-goto-char.")
E.g. `avy-goto-line' or `avy-goto-char'.")
(defun avy-tree (lst keys)
"Coerce LST into a balanced tree.
@@ -840,11 +839,11 @@ Set `avy-style' according to COMMAND as well."
avy-last-candidates))
(min-dist
(apply #'min
(mapcar (lambda (x) (abs (- (caar x) (point)))) avy-last-candidates)))
(mapcar (lambda (x) (abs (- (if (listp (car x)) (caar x) (car x)) (point)))) avy-last-candidates)))
(pos
(cl-position-if
(lambda (x)
(= (- (caar x) (point)) min-dist))
(= (- (if (listp (car x)) (caar x) (car x)) (point)) min-dist))
avy-last-candidates)))
(funcall advancer pos avy-last-candidates)))
@@ -854,7 +853,8 @@ Set `avy-style' according to COMMAND as well."
(avy--last-candidates-cycle
(lambda (pos lst)
(when (> pos 0)
(goto-char (caar (nth (1- pos) lst)))))))
(let ((candidate (nth (1- pos) lst)))
(goto-char (if (listp (car candidate)) (caar candidate) (car candidate))))))))
(defun avy-next ()
"Go to the next candidate of the last `avy-read'."
@@ -862,7 +862,8 @@ Set `avy-style' according to COMMAND as well."
(avy--last-candidates-cycle
(lambda (pos lst)
(when (< pos (1- (length lst)))
(goto-char (caar (nth (1+ pos) lst)))))))
(let ((candidate (nth (1+ pos) lst)))
(goto-char (if (listp (car candidate)) (caar candidate) (car candidate))))))))
;;;###autoload
(defun avy-process (candidates &optional overlay-fn cleanup-fn)
@@ -935,14 +936,14 @@ multiple OVERLAY-FN invocations."
(null (assoc invisible buffer-invisibility-spec)))))
(defun avy--next-visible-point ()
"Return the next closest point without 'invisible property."
"Return the next closest point without `invisible' property."
(let ((s (point)))
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
(not (avy--visible-p s))))
s))
(defun avy--next-invisible-point ()
"Return the next closest point with 'invisible property."
"Return the next closest point with `invisible' property."
(let ((s (point)))
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
(avy--visible-p s)))
@@ -1666,6 +1667,7 @@ When BOTTOM-UP is non-nil, display avy candidates from top to bottom"
(defvar linum-overlays)
(defvar linum-format)
(declare-function linum--face-width "linum")
(declare-function linum-mode "linum")
(define-minor-mode avy-linum-mode
"Minor mode that uses avy hints for `linum-mode'."

View File

@@ -1,930 +0,0 @@
;;; awesome-tray.el --- Modular tray bar
;; Filename: awesome-tray.el
;; Description: Modular tray bar
;; Author: Andy Stewart <lazycat.manatee@gmail.com>
;; Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
;; Copyright (C) 2018, Andy Stewart, all rights reserved.
;; Created: 2018-10-07 07:30:16
;; Version: 4.2
;; Last-Updated: 2020-06-18 21:02:39
;; By: Andy Stewart
;; URL: http://www.emacswiki.org/emacs/download/awesome-tray.el
;; Keywords:
;; Compatibility: GNU Emacs 27.0.50
;;
;; Features that might be required by this library:
;;
;; `cl-lib'
;; `subr-x'
;; `battery'
;;
;;; This file is NOT part of GNU Emacs
;;; License
;;
;; 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, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Modular tray bar.
;;
;; I don't like mode-line, it's too high, affect me to read the code.
;; With Emacs, we only need to focus on very little information, such as time, current mode, git branch.
;; Excessive information can seriously interfere with our attention.
;;
;;; Installation:
;;
;; Put awesome-tray.el to your load-path.
;; The load-path is usually ~/elisp/.
;; It's set in your ~/.emacs like this:
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
;;
;; And the following to your ~/.emacs startup file.
;;
;; (require 'awesome-tray)
;; (awesome-tray-mode 1)
;;
;; No need more.
;;; Customize:
;;
;; `awesome-tray-mode-line-active-color'
;; `awesome-tray-mode-line-inactive-color'
;; `awesome-tray-active-modules'
;; `awesome-tray-git-update-duration'
;; `awesome-tray-refresh-idle-delay'
;; `awesome-tray-buffer-name-buffer-changed'
;; `awesome-tray-buffer-name-buffer-changed-style'
;; `awesome-tray-input-method-en-style'
;; `awesome-tray-input-method-zh-style'
;; `awesome-tray-buffer-read-only-style'
;;
;; All of the above can customize by:
;; M-x customize-group RET awesome-tray RET
;;
;;; Change log:
;;
;; 2020/06/18
;; * Shorter date info.
;;
;; 2020/05/06
;; * Just show origin message if got any error, easy to debug.
;;
;; 2020/04/01
;; * Shorter tray info.
;;
;; 2020/02/27
;; * Adapter the latest version of the snails.
;; * Adjust algorithm of `awesome-tray-get-frame-width'.
;;
;; 2020/02/19
;; * Add week info in date.
;;
;; 2020/02/14
;; * Add `awesome-tray-battery-update-duration' to fix `set-mark-command' failed.
;;
;; 2020/02/10
;; * Add battery remaining time.
;;
;; 2020/02/05
;; * Add battery status.
;;
;; 2020/01/05
;; * Hide awesome-tab info if it is too long.
;;
;; 2019/08/20
;; * Use variable `awesome-tray-mode-line-default-height' fix issue #34.
;;
;; 2019/08/14
;; * Remove notify message when toggle awesome-tray status.
;;
;; 2019/08/13
;; * Keep tray info align right when message is very long, thanks QiangF.
;;
;; 2019/07/26
;; * Support snails framework.
;;
;; 2019/07/16
;; * Use `format-mode-line' improve performance of `awesome-tray-module-location-info'.
;;
;; 2019/07/15
;; * Use current-line save value of `line-number-at-pos', improve the performance of `awesome-tray-module-location-info'.
;; * Use `ignore-errors' catch error of awesome-tray.
;;
;; 2019/07/14
;; * Don't wrap awesome-tray info if variable `inhibit-message' is non-nil.
;;
;; 2019/06/23
;; * Support `awesome-tab' group indicator.
;; * Fix crash cause by `awesome-tray-module-awesome-tab-info'
;;
;; 2019/05/08
;; * Disable git modulde default, it have performance when we change buffer too fast.
;;
;; 2019/04/29
;; * Fix position not update when execute command `beginning-of-buffer' or `end-of-buffer'.
;;
;; 2019/04/25
;; * Add 'circe' module displaying circe tracking-buffer modeline info.
;; * The circe module is not activated by default, it's added to `awesome-tray-all-modules'.
;;
;; 2018/11/25
;; * Add `RVM' support.
;; * The rvm module is not activated by default, I move it to `awesome-tray-all-modules'.
;;
;; 2018/11/18
;; * Fix the problem of displaying duplicate information when the mouse is in the minibuffer window.
;;
;; 2018/11/12
;; * Remove Mac color, use hex color instead.
;;
;; 2018/11/03
;; * Add percent information in location module.
;; * Fix error: Not enough arguments for format string.
;;
;; 2018/10/29
;; * Use `unspecified' attribute fix black block of mode-line inactive status.
;; * Add `awesome-tray-git-update-duration' option.
;;
;; 2018/10/21
;; * Use `advice-add' re-implmenet `awesome-tray-message-advice'
;; * Add parent-dir module.
;; * Don't show parent-dir if current mode is `dired-mode'.
;;
;; 2018/10/13
;; * Use `awesome-tray-process-exit-code-and-output' fetch git current branch for better error handling.
;;
;; 2018/10/11
;; * Reimplement `awesome-tray-module-git-info' don't depend on magit.
;; * Add last-command module, handy for debug emacs.
;;
;; 2018/10/09
;; * Add new option `awesome-tray-active-modules'.
;;
;; 2018/10/07
;; * First released.
;; * Add row/column information.
;; * Add `awesome-tray-message-advice' make tray information visible always.
;; * Use `frame-width' instead `window-width' to handle blank characters fill.
;; * Don't fill blank if message string is wider than frame width.
;;
;;; Acknowledgements:
;;
;;
;;
;;; TODO
;;
;;
;;
;;; Require
(require 'cl-lib)
(require 'subr-x)
(require 'battery)
;;; Code:
(defgroup awesome-tray nil
"Modular tray bar."
:group 'awesome-tray)
(defcustom awesome-tray-mode-line-active-color "DarkRed"
"Active color."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-mode-line-inactive-color "Gray10"
"Inactive color."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-active-modules
'("location" "buffer-name" "belong" "file-path" "mode-name" "input-method" "battery" "date")
"Default active modules."
:type 'list
:group 'awesome-tray)
(defcustom awesome-tray-essential-modules
'("location" "buffer-name" "belong" "file-path")
"Default ellipsis modules, show when minibuffer is too long."
:type 'list
:group 'awesome-tray)
(defcustom awesome-tray-buffer-name-max-length 20
"Max length of buffer name."
:group 'awesome-tray
:type 'int)
(defcustom awesome-tray-file-name-max-length 20
"Max length of file name."
:group 'awesome-tray
:type 'int)
(defcustom awesome-tray-git-update-duration 5
"Update duration of git command, in seconds.
It's very slow start new process in Windows platform.
Maybe you need set this option with bigger value to speedup on Windows platform."
:type 'integer
:group 'awesome-tray)
(defcustom awesome-tray-belong-update-duration 5
"Update duration of which class, in seconds."
:type 'integer
:group 'awesome-tray)
(defcustom awesome-tray-battery-update-duration 5
"Update duration of battery status, in seconds.
It will make command `set-mark-command' failed if not use duration."
:type 'integer
:group 'awesome-tray)
(defcustom awesome-tray-refresh-idle-delay 0.5
"Update idle delay of awesome tray, in seconds."
:type 'double
:group 'awesome-tray)
(defcustom awesome-tray-buffer-name-buffer-changed-style "*"
"`awesome-tray-buffer-name-buffer-changed' style."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-buffer-name-buffer-changed nil
"Show the current buffer changes after buffer-name."
:type 'boolean
:group 'awesome-tray)
(defcustom awesome-tray-input-method-en-style "EN"
"English input method display style for input-method module."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-input-method-zh-style "ZH"
"Chinese input method display style for input-method module."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-buffer-read-only-style "R-O"
"Display style for buffer-read-only module."
:type 'string
:group 'awesome-tray)
(defcustom awesome-tray-file-path-show-filename nil
"Show filename in file-path module or not."
:type 'boolean
:group 'awesome-tray)
(defcustom awesome-tray-file-path-truncated-name-length 1
"In file-path module, how many letters to leave when truncate dirname.
Beginning dots are not counted."
:type 'integer
:group 'awesome-tray)
(defcustom awesome-tray-file-path-full-dirname-levels 2
"In file-path module, how many levels of parent directories should be shown in
their full name."
:type 'integer
:group 'awesome-tray)
(defcustom awesome-tray-file-path-truncate-dirname-levels 0
"In file-path module, how many levels of parent directories should be shown in
their first character.
These goes before those shown in their full names."
:type 'integer
:group 'awesome-tray)
(defface awesome-tray-default-face '((t :inherit default))
"Face for string constant ouside modules."
:group 'awesome-tray)
(defface awesome-tray-module-git-face
'((((background light))
:foreground "#cc2444" :bold t)
(t
:foreground "#ff2d55" :bold t))
"Git face."
:group 'awesome-tray)
(defface awesome-tray-module-rvm-face
'((((background light))
:foreground "#2832cc" :bold t)
(t
:foreground "#333fff" :bold t))
"RVM face."
:group 'awesome-tray)
(defface awesome-tray-module-circe-face
'((((background light))
:foreground "#2832cc" :bold t)
(t
:foreground "#333fff" :bold t))
"Circe face."
:group 'awesome-tray)
(defface awesome-tray-module-mode-name-face
'((((background light))
:foreground "#00a400" :bold t)
(t
:foreground "green3" :bold t))
"Mode name face."
:group 'awesome-tray)
(defface awesome-tray-module-location-face
'((((background light))
:foreground "#cc7700" :bold t)
(t
:foreground "#ff9500" :bold t))
"Location face."
:group 'awesome-tray)
(defface awesome-tray-module-date-face
'((((background light))
:foreground "#717175" :bold t)
(t
:foreground "#8e8e93" :bold t))
"Date face."
:group 'awesome-tray)
(defface awesome-tray-module-last-command-face
'((((background light))
:foreground "#0061cc" :bold t)
(t
:foreground "#007aff" :bold t))
"Date face."
:group 'awesome-tray)
(defface awesome-tray-module-buffer-name-face
'((((background light))
:foreground "#cc7700" :bold t)
(t
:foreground "#ff9500" :bold t))
"Buffer name face."
:group 'awesome-tray)
(defface awesome-tray-module-parent-dir-face
'((((background light))
:foreground "#5e8e2e" :bold t)
(t
:foreground "#9ded4d" :bold t))
"Parent dir face."
:group 'awesome-tray)
(defface awesome-tray-module-file-path-face
'((((background light))
:foreground "#5e8e2e" :bold t)
(t
:foreground "#9ded4d" :bold t))
"Parent dir face."
:group 'awesome-tray)
(defface awesome-tray-module-awesome-tab-face
'((((background light))
:foreground "#b83059" :bold t)
(t
:foreground "#e73c70" :bold t))
"Awesome tab face."
:group 'awesome-tray)
(defface awesome-tray-module-evil-face
'((((background light))
:foreground "#008080" :bold t)
(t
:foreground "#00ced1" :bold t))
"Evil state face."
:group 'awesome-tray)
(defface awesome-tray-module-battery-face
'((((background light))
:foreground "#008080" :bold t)
(t
:foreground "#00ced1" :bold t))
"Battery state face."
:group 'awesome-tray)
(defface awesome-tray-module-buffer-read-only-face
'((((background light))
:foreground "#cc2444" :bold t)
(t
:foreground "#ff2d55" :bold t))
"Buffer read only face."
:group 'awesome-tray)
(defface awesome-tray-module-belong-face
'((((background light))
:foreground "#cc2444" :bold t)
(t
:foreground "#ff2d55" :bold t))
"Buffer read only face."
:group 'awesome-tray)
(defface awesome-tray-module-input-method-face
'((((background light))
:foreground "#008080" :bold t)
(t
:foreground "#00ced1" :bold t))
"Input method face."
:group 'awesome-tray)
;;;###autoload
(define-minor-mode awesome-tray-mode
"Modular tray bar."
:require 'awesome-tray-mode
:global t
(if awesome-tray-mode
(awesome-tray-enable)
(awesome-tray-disable)))
(defvar awesome-tray-info-padding-right 0)
(defvar awesome-tray-mode-line-colors nil)
(defvar awesome-tray-timer nil)
(defvar awesome-tray-active-p nil)
(defvar awesome-tray-git-command-last-time 0)
(defvar awesome-tray-git-command-cache "")
(defvar awesome-tray-belong-last-time 0)
(defvar awesome-tray-belong-last-buffer nil)
(defvar awesome-tray-belong-cache "")
(defvar awesome-tray-battery-status-last-time 0)
(defvar awesome-tray-battery-status-cache "")
(defvar awesome-tray-last-tray-info nil)
(defvar awesome-tray-mode-line-default-height 1)
(defvar awesome-tray-module-alist
'(("awesome-tab" . (awesome-tray-module-awesome-tab-info awesome-tray-module-awesome-tab-face))
("buffer-name" . (awesome-tray-module-buffer-name-info awesome-tray-module-buffer-name-face))
("circe" . (awesome-tray-module-circe-info awesome-tray-module-circe-face))
("date" . (awesome-tray-module-date-info awesome-tray-module-date-face))
("evil" . (awesome-tray-module-evil-info awesome-tray-module-evil-face))
("file-path" . (awesome-tray-module-file-path-info awesome-tray-module-file-path-face))
("git" . (awesome-tray-module-git-info awesome-tray-module-git-face))
("last-command" . (awesome-tray-module-last-command-info awesome-tray-module-last-command-face))
("location" . (awesome-tray-module-location-info awesome-tray-module-location-face))
("parent-dir" . (awesome-tray-module-parent-dir-info awesome-tray-module-parent-dir-face))
("mode-name" . (awesome-tray-module-mode-name-info awesome-tray-module-mode-name-face))
("rvm" . (awesome-tray-module-rvm-info awesome-tray-module-rvm-face))
("battery" . (awesome-tray-module-battery-info awesome-tray-module-battery-face))
("input-method" . (awesome-tray-module-input-method-info awesome-tray-module-input-method-face))
("buffer-read-only" . (awesome-tray-module-buffer-read-only-info awesome-tray-module-buffer-read-only-face))
("belong" . (awesome-tray-module-belong-info awesome-tray-module-belong-face))
))
(defun awesome-tray-enable ()
;; Save mode-line colors when first time.
;; Don't change `awesome-tray-mode-line-colors' anymore.
(unless awesome-tray-mode-line-colors
(setq awesome-tray-mode-line-colors
(list (face-attribute 'mode-line :foreground)
(face-attribute 'mode-line :background)
(face-attribute 'mode-line :family)
(face-attribute 'mode-line :box)
(face-attribute 'mode-line-inactive :foreground)
(face-attribute 'mode-line-inactive :background)
(face-attribute 'mode-line-inactive :family)
(face-attribute 'mode-line-inactive :box)
)))
(setq awesome-tray-mode-line-default-height (face-attribute 'mode-line :height))
;; Disable mode line.
(set-face-attribute 'mode-line nil
:foreground awesome-tray-mode-line-active-color
:background awesome-tray-mode-line-active-color
:height 0.1
:box nil)
(set-face-attribute 'mode-line-inactive nil
:foreground awesome-tray-mode-line-inactive-color
:background awesome-tray-mode-line-inactive-color
:height 0.1
:box nil
:inherit 'unspecified)
;; Add update timer.
(setq awesome-tray-timer
(run-with-timer 0 awesome-tray-refresh-idle-delay 'awesome-tray-show-info))
(add-hook 'focus-in-hook 'awesome-tray-show-info)
(setq awesome-tray-active-p t))
(defun awesome-tray-disable ()
;; Restore mode-line colors.
(set-face-attribute 'mode-line nil
:foreground (nth 0 awesome-tray-mode-line-colors)
:background (nth 1 awesome-tray-mode-line-colors)
:family (nth 2 awesome-tray-mode-line-colors)
:box (nth 3 awesome-tray-mode-line-colors)
:height awesome-tray-mode-line-default-height)
(set-face-attribute 'mode-line-inactive nil
:foreground (nth 4 awesome-tray-mode-line-colors)
:background (nth 5 awesome-tray-mode-line-colors)
:family (nth 6 awesome-tray-mode-line-colors)
:box (nth 7 awesome-tray-mode-line-colors)
:height awesome-tray-mode-line-default-height)
;; Cancel timer.
(when (timerp awesome-tray-timer)
(cancel-timer awesome-tray-timer))
(remove-hook 'focus-in-hook 'awesome-tray-show-info)
;; Update mode-line.
(force-mode-line-update)
(redraw-display)
(with-current-buffer " *Minibuf-0*"
(erase-buffer))
(setq awesome-tray-active-p nil))
(defun awesome-tray-build-active-info ()
(condition-case nil
(mapconcat 'identity (cl-remove-if #'(lambda (n) (equal (length n) 0))
(mapcar 'awesome-tray-get-module-info awesome-tray-active-modules)) " ")
(format "Awesome Tray broken.")))
(defun awesome-tray-build-essential-info ()
(condition-case nil
(mapconcat 'identity (cl-remove-if #'(lambda (n) (equal (length n) 0))
(mapcar 'awesome-tray-get-module-info awesome-tray-essential-modules)) " ")
(format "Awesome Tray broken.")))
(defun awesome-tray-get-module-info (module-name)
(let* ((func (ignore-errors (cadr (assoc module-name awesome-tray-module-alist))))
(face-param (ignore-errors (caddr (assoc module-name awesome-tray-module-alist))))
(face (cond ((functionp face-param) (funcall face-param))
((facep face-param) face-param)
(t nil)))
(raw-info (ignore-errors (funcall func)))
(info (ignore-errors (if face (propertize raw-info 'face face) raw-info))))
(if func
(if info
info
(propertize "" 'face face))
(propertize module-name 'face 'awesome-tray-default-face))))
(defun awesome-tray-module-git-info ()
(if (executable-find "git")
(let ((current-seconds (awesome-tray-current-seconds)))
(if (> (- current-seconds awesome-tray-git-command-last-time) awesome-tray-git-update-duration)
(progn
(setq awesome-tray-git-command-last-time current-seconds)
(awesome-tray-update-git-command-cache))
awesome-tray-git-command-cache))
""))
(defun awesome-tray-module-circe-info ()
"Display circe tracking buffers"
(if (listp tracking-mode-line-buffers)
(apply 'concat (cl-loop for entry in tracking-mode-line-buffers
collect (or (plist-get entry :propertize) "")))
""))
(defun awesome-tray-module-rvm-info ()
(if (executable-find "rvm-prompt")
(format "rvm:%s" (replace-regexp-in-string
"\n" ""
(nth 1 (awesome-tray-process-exit-code-and-output "rvm-prompt")))
)
""))
(defun awesome-tray-module-battery-info ()
(let ((current-seconds (awesome-tray-current-seconds)))
(if (> (- current-seconds awesome-tray-battery-status-last-time) awesome-tray-battery-update-duration)
(let* ((battery-info (funcall battery-status-function))
(battery-type (battery-format "%L" battery-info))
battery-status)
(setq awesome-tray-battery-status-last-time current-seconds)
;; Short battery type.
(cond ((string-equal battery-type "on-line")
(setq battery-type "ON")
(setq battery-status (battery-format "-%p%%" battery-info)))
((string-equal battery-type "off-line")
(setq battery-type "OFF")
(setq battery-status (battery-format "-%p%% %t" battery-info))))
;; Update battery cache.
(setq awesome-tray-battery-status-cache (concat battery-type battery-status)))
awesome-tray-battery-status-cache)))
(defun awesome-tray-module-mode-name-info ()
(car (split-string (format "%s" major-mode) "-mode")))
(defun awesome-tray-module-location-info ()
(format "%s:%s %s"
(format-mode-line "%l")
(format-mode-line "%c")
(format-mode-line "%p")
))
(defun awesome-tray-module-date-info ()
(format-time-string "%m-%d %H:%M %a"))
(defun awesome-tray-module-last-command-info ()
(format "%s" last-command))
(defun awesome-tray-module-buffer-name-info ()
(let ((ellipsis "...")
bufname)
(setq bufname (if awesome-tray-buffer-name-buffer-changed
(if (and (buffer-modified-p)
(not (eq buffer-file-name nil)))
(concat (buffer-name) awesome-tray-buffer-name-buffer-changed-style)
(buffer-name))
(format "%s" (buffer-name))))
(if (> (length bufname) awesome-tray-buffer-name-max-length)
(format "%s%s" (substring bufname 0 (- awesome-tray-buffer-name-max-length (length ellipsis))) ellipsis)
bufname)))
(defun awesome-tray-module-buffer-read-only-info ()
(if (and (eq buffer-read-only t)
(not (eq buffer-file-name nil)))
(format "%s" awesome-tray-buffer-read-only-style)))
(defun awesome-tray-module-input-method-info ()
(if (eq current-input-method nil)
(format "%s" awesome-tray-input-method-en-style)
(format "%s" awesome-tray-input-method-zh-style)))
(defun awesome-tray-module-parent-dir-info ()
(format "%s" (file-name-nondirectory (directory-file-name default-directory))))
(defun awesome-tray-shrink-dir-name (name)
"Shrink NAME to be its first letter, or the first two if starts \".\"
NAME is a string, typically a directory name."
(let ((dot-num (if (string-match "^\\.+" name)
(length (match-string 0 name))
0)))
(substring name 0 (min (length name) (+ dot-num awesome-tray-file-path-truncated-name-length)))))
(defun awesome-tray-module-file-path-info ()
(if (not buffer-file-name)
(let ((ellipsis "...")
(bufname (buffer-name)))
(setq bufname (if awesome-tray-buffer-name-buffer-changed
(if (and (buffer-modified-p)
(not (eq buffer-file-name nil)))
(concat (buffer-name) awesome-tray-buffer-name-buffer-changed-style)
(buffer-name))
(format "%s" (buffer-name))))
(if (> (length bufname) awesome-tray-file-name-max-length)
(format "%s%s" (substring bufname 0 (- awesome-tray-file-name-max-length (length ellipsis))) ellipsis)
bufname))
(let* ((file-path (split-string (buffer-file-name) "/" t))
(shown-path)
(path-len (length file-path))
(modp (if (buffer-modified-p) "*" ""))
(full-num awesome-tray-file-path-full-dirname-levels)
(trunc-num awesome-tray-file-path-truncate-dirname-levels)
(show-name awesome-tray-file-path-show-filename))
(when (> path-len (+ 1 full-num))
(push (string-join
(mapcar #'awesome-tray-shrink-dir-name
(cl-subseq file-path
(max 0 (- path-len (+ 1 full-num trunc-num)))
(- path-len (1+ full-num)))) "/")
shown-path))
(when (> path-len 1)
(push (string-join
(cl-subseq file-path
(max 0 (- path-len (1+ full-num)))
(1- path-len)) "/")
shown-path))
(when show-name
(push (car (last file-path)) shown-path))
(concat modp
(if (<= path-len (+ 1 full-num trunc-num))
"/"
".../")
(string-join (nreverse (cl-remove "" shown-path)) "/")
(when (and shown-path (not show-name)) "/")))))
(defun awesome-tray-module-awesome-tab-info ()
(with-demoted-errors
""
(if (featurep 'awesome-tab)
(let ((tab-info (format "%s" (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))))
(if (> (string-width tab-info) 30)
""
tab-info))
"")))
(defun awesome-tray-module-evil-info ()
(with-demoted-errors
""
(if (featurep 'evil)
(let ((state
(cond ((evil-normal-state-p) "<N>")
((evil-emacs-state-p) "<E>")
((evil-insert-state-p) "<I>")
((evil-motion-state-p) "<M>")
((evil-visual-state-p) "<V>")
((evil-operator-state-p) "<O>")
((evil-replace-state-p) "<R>")
(t ""))))
state)
"")))
(defun awesome-tray-module-belong-info ()
(if (featurep 'tree-sitter)
(let ((current-seconds (awesome-tray-current-seconds)))
(if (or (not (eq (current-buffer) awesome-tray-belong-last-buffer))
(> (- current-seconds awesome-tray-belong-last-time) awesome-tray-belong-update-duration))
(progn
(setq awesome-tray-belong-last-time current-seconds)
(setq awesome-tray-belong-last-buffer (current-buffer))
(awesome-tray-update-belong-cache))
awesome-tray-belong-cache))
""))
(defun awesome-tray-update-belong-cache ()
(setq awesome-tray-belong-cache
(let* ((class-nodes (append (awesome-tray-get-match-nodes "(class_definition name: (symbol) @x)")
(awesome-tray-get-match-nodes "(class_definition name: (identifier) @x)")))
(function-nodes (append (awesome-tray-get-match-nodes "(function_definition name: (symbol) @x)")
(awesome-tray-get-match-nodes "(function_definition name: (identifier) @x)")))
which-belong-info
which-class-info
which-func-info)
(setq which-class-info (catch 'found
(dolist (class-node class-nodes)
(when (and (> (point) (tsc-node-start-position (tsc-get-parent class-node)))
(< (point) (tsc-node-end-position (tsc-get-parent class-node))))
(throw 'found (tsc-node-text class-node)))
)
(throw 'found "")))
(setq which-func-info (catch 'found
(dolist (function-node function-nodes)
(when (and (> (point) (tsc-node-start-position (tsc-get-parent function-node)))
(< (point) (tsc-node-end-position (tsc-get-parent function-node))))
(throw 'found (tsc-node-text function-node)))
)
(throw 'found "")))
(setq which-belong-info (string-trim (concat which-class-info " " which-func-info)))
(if (string-equal which-belong-info "")
""
(format "[%s]" which-belong-info))))
awesome-tray-belong-cache)
(defun awesome-tray-get-match-nodes (match-rule)
(ignore-errors
(let* ((query (tsc-make-query tree-sitter-language match-rule))
(root-node (tsc-root-node tree-sitter-tree))
(captures (mapcar #'cdr (tsc-query-captures query root-node #'tsc--buffer-substring-no-properties))))
captures)))
(defun awesome-tray-show-info ()
;; Only flush tray info when current message is empty.
(unless (current-message)
(awesome-tray-flush-info)))
(defun awesome-tray-get-frame-width ()
"Only calculating a main Frame width, to avoid wrong width when new frame, such as `snails'."
(if (display-graphic-p)
(with-selected-frame (car (last (frame-list)))
(frame-width))
(frame-width)))
(defun awesome-tray-flush-info ()
(let* ((tray-info (awesome-tray-build-active-info)))
(with-current-buffer " *Minibuf-0*"
(erase-buffer)
(insert (concat (make-string (max 0 (- (awesome-tray-get-frame-width) (string-width tray-info) awesome-tray-info-padding-right)) ?\ ) tray-info)))))
(defun awesome-tray-get-echo-format-string (message-string)
(let* ((tray-info (awesome-tray-build-active-info))
(blank-length (- (awesome-tray-get-frame-width) (string-width tray-info) (string-width message-string) awesome-tray-info-padding-right)))
(prog1
(cond
;; Fill message's end with whitespace to keep tray info at right of minibuffer.
((> blank-length 0)
(concat message-string
(make-string (max 0 (- (awesome-tray-get-frame-width)
(string-width message-string)
(string-width tray-info)
awesome-tray-info-padding-right)) ?\ )
tray-info))
;; Fill empty whitespace if new message contain duplicate tray-info (cause by move mouse on minibuffer window).
((and awesome-tray-last-tray-info
message-string
(string-suffix-p awesome-tray-last-tray-info message-string))
(concat (make-string (max 0 (- (awesome-tray-get-frame-width)
(string-width tray-info)
awesome-tray-info-padding-right)) ?\ )
tray-info))
(t
(let* ((essential-info (awesome-tray-build-essential-info))
(fill-string (make-string (max 0 (- (awesome-tray-get-frame-width)
(string-width essential-info)
(string-width message-string)
awesome-tray-info-padding-right)) ?\ )))
(if (> (+ (string-width message-string) (string-width fill-string) (string-width essential-info))
(awesome-tray-get-frame-width))
;; Don't show tray information if message is too long.
message-string
(concat message-string fill-string essential-info))
)))
;; Record last tray information.
(setq awesome-tray-last-tray-info tray-info))))
(defun awesome-tray-process-exit-code-and-output (program &rest args)
"Run PROGRAM with ARGS and return the exit code and output in a list."
(with-temp-buffer
(list (apply 'call-process program nil (current-buffer) nil args)
(buffer-string))))
(defun awesome-tray-current-seconds ()
(string-to-number (format-time-string "%s")))
(defun awesome-tray-update-git-command-cache ()
(let* ((git-info (awesome-tray-process-exit-code-and-output "git" "symbolic-ref" "--short" "HEAD"))
(status (nth 0 git-info))
(result (format "git:%s" (nth 1 git-info))))
(setq awesome-tray-git-command-cache
(if (equal status 0)
(replace-regexp-in-string "\n" "" result)
""))
awesome-tray-git-command-cache))
;; Wrap `message' make tray information visible always
;; even other plugins call `message' to flush minibufer.
(defun awesome-tray-message-advice (old-message &rest arguments)
(if (ignore-errors
(cond
;; Don't wrap tray info if `awesome-tray-active-p' is nil.
((not awesome-tray-active-p)
(apply old-message arguments))
;; Don't wrap awesome-tray info if variable `inhibit-message' is non-nil.
(inhibit-message
(apply old-message arguments))
;; Just flush tray info if message string is empty.
((not (car arguments))
(apply old-message arguments)
(awesome-tray-flush-info))
;; Otherwise, wrap message string with tray info and show it in echo area,
;; logging origin message at `*Messages*' buffer if allowed.
(t
(if message-log-max
(let ((inhibit-message t))
(apply old-message arguments)))
(let ((message-log-max nil))
(apply old-message "%s" (cons (awesome-tray-get-echo-format-string (apply 'format arguments)) '())))))
;; Return t if everything is okay.
t)
;; Return origin message string. if not, `message' function will always return `nil'.
(if (car arguments)
(apply 'format arguments))
(apply old-message arguments)))
(advice-add #'message :around #'awesome-tray-message-advice)
(defun awesome-tray-current-message-advice (old-func &rest arguments)
(let ((message-string (apply old-func arguments)))
(if (and message-string awesome-tray-last-tray-info)
(string-trim-right (replace-regexp-in-string awesome-tray-last-tray-info "" message-string))
message-string)))
(advice-add #'current-message :around #'awesome-tray-current-message-advice)
(defun awesome-tray-end-of-buffer-advice (old-func &rest arguments)
(apply old-func arguments)
(message ""))
(advice-add #'end-of-buffer :around #'awesome-tray-end-of-buffer-advice)
(defun awesome-tray-beginning-of-buffer-advice (old-func &rest arguments)
(apply old-func arguments)
(message ""))
(advice-add #'beginning-of-buffer :around #'awesome-tray-beginning-of-buffer-advice)
(provide 'awesome-tray)
;;; awesome-tray.el ends here

134
lisp/awesome-tray/README.md Normal file
View File

@@ -0,0 +1,134 @@
<img src="./screenshots/screenshot.png">
[More screenshots](./screenshots/README.md)
### What's this?
I don't like the mode-line, it's too high and affect me to read the code.
With Emacs, we only need to focus on very little information, such as time, current mode, git branch.
Excessive information can seriously interfere with our attention.
## Installation
Clone this repository
```console
$ git clone --depth=1 https://github.com/manateelazycat/awesome-tray.git
```
Then put awesome-tray.el to your load-path.
The load-path is usually `~/elisp/`. It's set in your `~/.emacs` like this:
```Elisp
(add-to-list `load-path (expand-file-name "~/elisp"))
(require 'awesome-tray)
(awesome-tray-mode 1)
```
## Customize Mode line.
- `awesome-tray-hide-mode-line`: Enabled by default, makes the mode-line very thin and highlight it when its active/inactive.
- `awesome-tray-mode-line-active-color`: Use for customize active color.
- `awesome-tray-mode-line-inactive-color`: Use for customize inactive color.
- `awesome-tray-adjust-mode-line-color-enable`: Disabled by default. If non-nil, adjust mode-line color when buffer state changes.
- `awesome-tray-mode-line-modified-readonly-color`: Use for customize modified and readonly color.
- `awesome-tray-mode-line-readonly-color`: Use for customize readonly color.
- `awesome-tray-mode-line-modified-color`: Use for customize modified color.
- `awesome-tray-mode-line-height`: Mode line height, default is 0.1
- `awesome-tray-date-format`: Use to customize the date string format.
- `awesome-tray-mpd-format`: Use to customize the mpd string format, see the variable docstring for details.
- `awesome-tray-git-format`: Use to customize the git string format.
- `awesome-tray-location-format`: Use to customize the location string format, see `mode-line-format`.
- `awesome-tray-location-info-all`: Use to customize the location "All", if `mode-line-format` contains `%p`.
- `awesome-tray-location-info-top`: Use to customize the location "Top", if `mode-line-format` contains `%p`.
- `awesome-tray-location-info-bottom`: Use to customize the location "Bottom", if `mode-line-format` contains `%p`.
- `awesome-tray-git-show-status`: If non-nil, show current file status on the git module.
- `awesome-tray-ellipsis`: Use to customize the ellipses used when truncating.
- `awesome-tray-separator`: Use to customize the separator between modules.
- `awesome-tray-evil-show-mode`: If non-nil, show current evil mode in the evil module.
- `awesome-tray-evil-show-macro`: If non-nil, show recording macro in the evil module.
- `awesome-tray-evil-show-cursor-count`: If non-nil, show multiple cursors count in the evil module.
- `awesome-tray-github-update-duration`: Update duration of the github notification, in seconds.
- `awesome-tray-github-erase-duration`: Github notification time before it gets removed from the bar, in seconds.
- `awesome-tray-meow-show-mode`: If non-nil, show current meow mode in the meow module.
- `awesome-tray-input-method-default-style`: Input method indicator you want to show when no input method is toggled on.
- `awesome-tray-input-method-local-style`: Input method indicator for your local input method.
- `awesome-tray-input-method-local-methods`: List of input methods as your local input method. If input method is toggled on, but not a member of this list, `input-method-title` will display in as input method indicator in awesome-tray, such as "DE@" for German. Default is "rime".
## Dangerous options
Please read the docstring for those variables
**Those options can make your awesome-tray look weird, if your minibuffer looks weird disable them**
- `awesome-tray-second-line`: [screenshot](./screenshots/screenshot2.png), Displays awesome-tray in a second line keeping the minibuffer messages readable.
- `awesome-tray-position`: [screenshot](./screenshots/centered.png), Displays awesome-tray in the left, right or center, better to be used with `awesome-tray-second-line` enabled.
## Customize Module
You can control modules through option ```awesome-tray-active-modules```.
**When changing the modules load awesome-tray-mode after setting the modules to prevent useless hooks and changes**
You can find all modules name in the keys of variable ```awesome-tray-module-alist```. Currently we have:
- `awesome-tab`: Show group information of [awesome-tab](https://github.com/manateelazycat/awesome-tab).
- `buffer-name`: Show buffer name.
- `circe`: Show circe tracking buffer information.
- `date`: Show current date.
- `celestial`: If you are not settled for date, you can add lunar phase and sunrise/set time. Requires `celestial-mode-line` package.
- `evil`: Show evil state, recording macro and multiple cursors count in both [evil-mc](https://github.com/gabesoft/evil-mc) and [multiple-cursors](https://github.com/magnars/multiple-cursors.el).
- `file-path`: Show file path with full customizability. When the path is long, it can be shrinked into something like `.../.em/el/awesome-tray/awesome-tray.el`. See `awesome-tray-file-path-***` variables for details.
- `git`: Show git information.
- `last-command`: Show last execute command.
- `location`: Show point position in buffer.
- `pdf-view-page`: Show page number in pdf-view-mode.
- `location-or-page`: Show location or pdf page number depends on current mode.
- `parent-dir`: Show direct parent directory.
- `mode-name`: Show major mode name.
- `rvm`: Show Ruby version information given by `rvm-prompt`.
- `battery`: Show battery status.
- `input-method`: Show input method status.
- `buffer-read-only`: Show read only status.
- `belong`: Show which class/function status, need install `treesit` first.
- `org-pomodoro`: Show `org-pomodoro` status. Denote the rest time of pomodoro by `[.]`, short break by `(.)` and long break by `{.}`.
- `flymake`: Show Flymake state.
- `flycheck`: Show Flycheck state.
- `meow`: Show meow state.
- `mpd`: Show mpd information using [libmpdel](https://github.com/mpdel/libmpdel), you need to connect to a mpd profile, use `(libmpdel-connect-profile (libmpdel--select-profile))` unless you have multiple profiles.
- `volume`: Show current volume using [volume.el](https://github.com/dbrock/volume.el).
- `word-count`: Show file and selected region word-count.
- `anzu`: Show searched word count and current index using [anzu](https://github.com/emacsorphanage/anzu).
- `github`: Show github notifications using [async](https://github.com/jwiegley/emacs-async) and [ghub](https://github.com/magit/ghub).
- `hostname`: Show remote buffers hostname.
## Create a Module
Let's create a module that says hello to you. With a module you need:
- A name. Let's simply call it "hello".
- A info function that returns the string to be displayed. Here's a simple one
``` emacs-lisp
(defun my-module-hello-info ()
(concat "Hello " (user-login-name) "!"))
```
A complex info function may encounter an error, awesome-tray will handle this and not show any information there.
- a face. Let's use a simple yet elegant italic style:
``` emacs-lisp
(defface my-module-hello-face
'((t (:italic t)))
"Hello module face."
:group 'awesome-tray)
```
- Awesome-tray uses `awesome-tray-module-alist` to find informations about a module. Let's put ours in it:
``` emacs-lisp
(add-to-list 'awesome-tray-module-alist
'("hello" . (my-module-hello-info my-module-hello-face)))
```
- Now put `"hello"` in the `awesome-tray-active-modules` list, and you will see awesome-tray say hello to you!
If you created a module that could be useful to others, please consider contributing it to awesome-tray!

View File

@@ -0,0 +1,293 @@
;;; awesome-tray-faces.el --- Faces for Awesome Tray -*-lexical-binding: t; -*-
;;
;; This file is not part of GNU Emacs.
;;
;; 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;;
;; This module provides the faces for Awesome Tray.
;;
;;; Code:
;; Base Faces:
(defface awesome-tray-default-face '((t :inherit default :bold t))
"Face for string constant ouside modules."
:group 'awesome-tray)
(defface awesome-tray-grey-face
'((((background light)) :foreground "dim grey" :bold t)
(t :foreground "dark grey" :bold t))
"Awesome tray grey."
:group 'awesome-tray)
(defface awesome-tray-red-face
'((((background light)) :foreground "#cc2444" :bold t)
(t :foreground "#ff2d55" :bold t))
"Awesome tray red."
:group 'awesome-tray)
(defface awesome-tray-green-face
'((((background light)) :foreground "#00a400" :bold t)
(t :foreground "green3" :bold t))
"Awesome tray green."
:group 'awesome-tray)
(defface awesome-tray-green-path-face
'((((background light)) :foreground "#5e8e2e" :bold t)
(t :foreground "#9ded4d" :bold t))
"Awesome green face for paths."
:group 'awesome-tray)
(defface awesome-tray-blue-face
'((((background light)) :foreground "#2832cc" :bold t)
(t :foreground "#333fff" :bold t))
"Awesome tray blue."
:group 'awesome-tray)
(defface awesome-tray-blue-bright-face
'((((background light)) :foreground "#0061cc" :bold t)
(t :foreground "#007aff" :bold t))
"Date face."
:group 'awesome-tray)
(defface awesome-tray-orange-face
'((((background light)) :foreground "#cc7700" :bold t)
(t :foreground "#ff9500" :bold t))
"Awesome tray orange."
:group 'awesome-tray)
(defface awesome-tray-yellow-face
'((((background light)) :foreground "gold" :bold t)
(t :foreground "yellow" :bold t))
"Awesome tray yellow."
:group 'awesome-tray)
(defface awesome-tray-pink-face
'((((background light)) :foreground "deep pink" :bold t)
(t :foreground "hot pink" :bold t))
"Awesome tab pink."
:group 'awesome-tray)
(defface awesome-tray-magenta-face
'((((background light)) :foreground "dark magenta" :bold t)
(t :foreground "magenta" :bold t))
"Awesome tray magenta."
:group 'awesome-tray)
(defface awesome-tray-cyan-face
'((((background light)) :foreground "#008080" :bold t)
(t :foreground "#00ced1" :bold t))
"Awesome tray cyan."
:group 'awesome-tray)
;; Contextual Faces
(defface awesome-tray-module-git-face
'((((background light)) :inherit awesome-tray-red-face)
(t :inherit awesome-tray-red-face))
"Git face."
:group 'awesome-tray)
(defface awesome-tray-module-awesome-tab-face
'((((background light)) :inherit awesome-tray-pink-face)
(t :inherit awesome-tray-pink-face))
"Awesome tab face."
:group 'awesome-tray)
(defface awesome-tray-module-rvm-face
'((((background light)) :inherit awesome-tray-blue-face)
(t :inherit awesome-tray-blue-face))
"RVM face."
:group 'awesome-tray)
(defface awesome-tray-module-circe-face
'((((background light)) :inherit awesome-tray-blue-face)
(t :inherit awesome-tray-blue-face))
"Circe face."
:group 'awesome-tray)
(defface awesome-tray-module-mode-name-face
'((((background light)) :inherit awesome-tray-green-face)
(t :inherit awesome-tray-green-face))
"Mode name face."
:group 'awesome-tray)
(defface awesome-tray-module-location-face
'((((background light)) :inherit awesome-tray-orange-face)
(t :inherit awesome-tray-orange-face))
"Location face."
:group 'awesome-tray)
(defface awesome-tray-module-location-or-page-face
'((((background light)) :inherit awesome-tray-orange-face)
(t :inherit awesome-tray-orange-face))
"Location or page face."
:group 'awesome-tray)
(defface awesome-tray-module-word-count-face
'((((background light)) :inherit awesome-tray-orange-face)
(t :inherit awesome-tray-orange-face))
"Word count face."
:group 'awesome-tray)
(defface awesome-tray-module-anzu-face
'((((background light)) :inherit awesome-tray-orange-face)
(t :inherit awesome-tray-orange-face))
"Anzu face."
:group 'awesome-tray)
(defface awesome-tray-module-github-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Github face."
:group 'awesome-tray)
(defface awesome-tray-module-hostname-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Hostname face."
:group 'awesome-tray)
(defface awesome-tray-module-volume-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Volume face."
:group 'awesome-tray)
(defface awesome-tray-module-mpd-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Mpd face."
:group 'awesome-tray)
(defface awesome-tray-module-date-face
'((((background light)) :inherit awesome-tray-grey-face)
(t :inherit awesome-tray-grey-face))
"Date face."
:group 'awesome-tray)
(defface awesome-tray-module-celestial-face
'((((background light)) :inherit awesome-tray-grey-face)
(t :inherit awesome-tray-grey-face))
"Celestial lunar phase and sunrise/set face."
:group 'awesome-tray)
(defface awesome-tray-module-last-command-face
'((((background light)) :inherit awesome-tray-blue-bright-face)
(t :inherit awesome-tray-blue-bright-face))
"Date face."
:group 'awesome-tray)
(defface awesome-tray-module-buffer-name-face
'((((background light)) :inherit awesome-tray-orange-face)
(t :inherit awesome-tray-orange-face))
"Buffer name face."
:group 'awesome-tray)
(defface awesome-tray-module-file-path-face
'((((background light)) :inherit awesome-tray-green-path-face)
(t :inherit awesome-tray-green-path-face))
"Parent dir face."
:group 'awesome-tray)
(defface awesome-tray-module-parent-dir-face
'((((background light)) :inherit awesome-tray-green-path-face)
(t :inherit awesome-tray-green-path-face))
"Parent dir face."
:group 'awesome-tray)
(defface awesome-tray-module-awesome-tab-face
'((((background light)) :inherit awesome-tray-pink-face)
(t :inherit awesome-tray-pink-face))
"Awesome tab face."
:group 'awesome-tray)
(defface awesome-tray-module-evil-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Evil state face."
:group 'awesome-tray)
(defface awesome-tray-module-meow-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Meow state face."
:group 'awesome-tray)
(defface awesome-tray-module-battery-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Battery state face."
:group 'awesome-tray)
(defface awesome-tray-module-buffer-read-only-face
'((((background light)) :inherit awesome-tray-red-face)
(t :inherit awesome-tray-red-face))
"Buffer read only face."
:group 'awesome-tray)
(defface awesome-tray-module-belong-face
'((((background light)) :inherit awesome-tray-red-face)
(t :inherit awesome-tray-red-face))
"Buffer read only face."
:group 'awesome-tray)
(defface awesome-tray-module-input-method-face
'((((background light)) :inherit awesome-tray-cyan-face)
(t :inherit awesome-tray-cyan-face))
"Input method face."
:group 'awesome-tray)
(defface awesome-tray-module-clock-face
'((((background light)) :inherit awesome-tray-blue-bright-face)
(t :inherit awesome-tray-blue-bright-face))
"Org clock face."
:group 'awesome-tray)
(defface awesome-tray-module-org-pomodoro-face
'((((background light)) :inherit awesome-tray-magenta-face)
(t :inherit awesome-tray-magenta-face))
"Org-pomodoro face."
:group 'awesome-tray)
(defface awesome-tray-module-pdf-view-page-face
'((((background light)) :inherit awesome-tray-orange)
(t :inherit awesome-tray-pink-face))
"Pdf-view-page face."
:group 'awesome-tray)
(defface awesome-tray-module-flymake-error
'((t :inherit awesome-tray-red-face))
"Flymake error face."
:group 'awesome-tray)
(defface awesome-tray-module-flymake-warning
'((t :inherit awesome-tray-yellow-face))
"Flymake warning face."
:group 'awesome-tray)
(defface awesome-tray-module-flymake-note
'((t :inherit awesome-tray-blue-bright-face))
"Flymake note face."
:group 'awesome-tray)
(provide 'awesome-tray-faces)
;;; awesome-tray-faces.el ends here

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,11 @@
# Screenshots
<img src="./screenshot.png">
# With `awesome-tray-second-line` enabled
<img src="./screenshot2.png">
# With `awesome-tray-position` set to center
<img src="./centered.png">

Binary file not shown.

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 222 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 18 KiB

View File

@@ -0,0 +1,13 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "biblio-core" "20230202.1721"
"A framework for looking up and displaying bibliographic entries."
'((emacs "24.3")
(let-alist "1.0.4")
(seq "1.11")
(dash "2.12.1"))
:url "https://github.com/cpitclaudel/biblio.el"
:commit "ee52f6cda82ea6fbc3b400e7b12132595cc0374c"
:revdesc "ee52f6cda82e"
:keywords '("bib" "tex" "convenience" "hypermedia")
:authors '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")))

View File

@@ -3,9 +3,8 @@
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; Version: 0.2.1
;; Package-Version: 20210418.406
;; Package-Commit: 517ec18f00f91b61481214b178f7ae0b8fbc499b
;; Package-Version: 20230202.1721
;; Package-Revision: ee52f6cda82e
;; Package-Requires: ((emacs "24.3") (let-alist "1.0.4") (seq "1.11") (dash "2.12.1"))
;; Keywords: bib, tex, convenience, hypermedia
;; URL: https://github.com/cpitclaudel/biblio.el
@@ -215,7 +214,7 @@ URL and CALLBACK; see `url-queue-retrieve'"
(if biblio-synchronous
(with-current-buffer (url-retrieve-synchronously url)
(funcall callback nil))
(setq url-queue-timeout 1)
(setq url-queue-timeout 5)
(url-queue-retrieve url callback)))
(defun biblio-strip (str)
@@ -485,7 +484,10 @@ will be called with the metadata of the current item.")
(defun biblio--completing-read-function ()
"Return ido, unless user picked another completion package."
(if (eq completing-read-function #'completing-read-default)
(if (and (eq completing-read-function #'completing-read-default)
(not (catch 'advised ;; https://github.com/cpitclaudel/biblio.el/issues/55
(advice-mapc (lambda (&rest _args) (throw 'advised t))
'completing-read-default))))
#'ido-completing-read
completing-read-function))

View File

@@ -65,7 +65,7 @@
(defun biblio-dblp--url (query)
"Create a DBLP url to look up QUERY."
(format "https://dblp.uni-trier.de/search/publ/api?q=%s&format=xml" (url-encode-url query)))
(format "https://dblp.org/search/publ/api?q=%s&format=xml" (url-encode-url query)))
;;;###autoload
(defun biblio-dblp-backend (command &optional arg &rest more)

View File

@@ -1,13 +1,11 @@
(define-package "biblio" "20210418.406" "Browse and import bibliographic references from CrossRef, arXiv, DBLP, HAL, Dissemin, and doi.org"
'((emacs "24.3")
(biblio-core "0.2"))
:commit "368f45bf9a64450705a63598224c5af96160af76" :authors
'(("Clément Pit-Claudel" . "clement.pitclaudel@live.com"))
:maintainer
'("Clément Pit-Claudel" . "clement.pitclaudel@live.com")
:keywords
'("bib" "tex" "convenience" "hypermedia")
:url "https://github.com/cpitclaudel/biblio.el")
;; Local Variables:
;; no-byte-compile: t
;; End:
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "biblio" "20250409.2132"
"Browse and import bibliographic references and BibTeX records from CrossRef, arXiv, DBLP, HAL, IEEE Xplore, Dissemin, and doi.org."
'((emacs "24.3")
(biblio-core "0.3"))
:url "https://github.com/cpitclaudel/biblio.el"
:commit "0314982c0ca03d0f8e0ddbe9fc20588c35021098"
:revdesc "0314982c0ca0"
:keywords '("bib" "tex" "convenience" "hypermedia")
:authors '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")))

View File

@@ -3,8 +3,9 @@
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; Version: 0.2
;; Package-Requires: ((emacs "24.3") (biblio-core "0.2"))
;; Package-Version: 20250409.2132
;; Package-Revision: 0314982c0ca0
;; Package-Requires: ((emacs "24.3") (biblio-core "0.3"))
;; Keywords: bib, tex, convenience, hypermedia
;; URL: https://github.com/cpitclaudel/biblio.el

View File

@@ -0,0 +1,16 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "bibtex-completion" "20241116.726"
"A BibTeX backend for completion frameworks."
'((parsebib "6.0")
(s "1.9.0")
(dash "2.6.0")
(f "0.16.2")
(cl-lib "0.5")
(biblio "0.2")
(emacs "26.1"))
:url "https://github.com/tmalsburg/helm-bibtex"
:commit "6064e8625b2958f34d6d40312903a85c173b5261"
:revdesc "6064e8625b29"
:authors '(("Titus von der Malsburg" . "malsburg@posteo.de")
("Justin Burkett" . "justin@burkett.cc"))
:maintainers '(("Titus von der Malsburg" . "malsburg@posteo.de")))

View File

@@ -4,10 +4,9 @@
;; Justin Burkett <justin@burkett.cc>
;; Maintainer: Titus von der Malsburg <malsburg@posteo.de>
;; URL: https://github.com/tmalsburg/helm-bibtex
;; Package-Version: 20221024.857
;; Package-Commit: 78f5931e1cc82e7ae2bcf0508cf31d0d1629a8dd
;; Version: 1.0.0
;; Package-Requires: ((parsebib "1.0") (s "1.9.0") (dash "2.6.0") (f "0.16.2") (cl-lib "0.5") (biblio "0.2") (emacs "26.1"))
;; Package-Version: 20241116.726
;; Package-Revision: 6064e8625b29
;; Package-Requires: ((parsebib "6.0") (s "1.9.0") (dash "2.6.0") (f "0.16.2") (cl-lib "0.5") (biblio "0.2") (emacs "26.1"))
;; 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
@@ -79,6 +78,20 @@ composed of the BibTeX-key plus a \".pdf\" suffix."
:group 'bibtex-completion
:type '(choice directory (repeat directory)))
;; From https://github.com/mwlodarczak/helm-bibtex/commit/4a421cae9b7d4cdb4a0933080633564b1774addb
(defcustom bibtex-completion-watch-bibliography t
"If non-nil (the default) the bibliography is reloaded
proactively every time any of the BibTeX files changes.
Changing the value of this variable after you load helm-bibtex
has no effect: if you load helm-bibtex with this variable
set to t and then decide you do not want to proactively reload the
bibliography, you have to restart Emacs with the new setting
(and likewise for loading helm-bibtex with the variable set to nil
and later deciding you want to proactively reload the bibliography)."
:group 'bibtex-completion
:type 'boolean)
(defcustom bibtex-completion-pdf-open-function 'find-file
"The function used for opening PDF files.
This can be an arbitrary function that takes one argument: the
@@ -116,6 +129,7 @@ This should be a single character."
(defcustom bibtex-completion-format-citation-functions
'((org-mode . bibtex-completion-format-citation-ebib)
(latex-mode . bibtex-completion-format-citation-cite)
(LaTeX-mode . bibtex-completion-format-citation-cite)
(markdown-mode . bibtex-completion-format-citation-pandoc-citeproc)
(python-mode . bibtex-completion-format-citation-sphinxcontrib-bibtex)
(rst-mode . bibtex-completion-format-citation-sphinxcontrib-bibtex)
@@ -282,6 +296,7 @@ browser in `helm-browse-url-default-browser-alist'"
"Autocite" "autocite*" "Autocite*" "citeauthor" "Citeauthor"
"citeauthor*" "Citeauthor*" "citetitle" "citetitle*" "citeyear"
"citeyear*" "citedate" "citedate*" "citeurl" "nocite" "fullcite"
"citet" "citep" "citet*" "citep*"
"footfullcite" "notecite" "Notecite" "pnotecite" "Pnotecite"
"fnotecite")
"The list of LaTeX cite commands.
@@ -416,15 +431,16 @@ Also sets `bibtex-completion-display-formats-internal'."
;; watches for automatic reloading of the bibliography when a file
;; is changed:
(mapc (lambda (file)
(if (f-file? file)
(let ((watch-descriptor
(file-notify-add-watch file
'(change)
(lambda (event) (bibtex-completion-candidates)))))
(setq bibtex-completion-file-watch-descriptors
(cons watch-descriptor bibtex-completion-file-watch-descriptors)))
(if (f-file? file)
(if bibtex-completion-watch-bibliography
(let ((watch-descriptor
(file-notify-add-watch file
'(change)
(lambda (event) (bibtex-completion-candidates)))))
(setq bibtex-completion-file-watch-descriptors
(cons watch-descriptor bibtex-completion-file-watch-descriptors))))
(user-error "Bibliography file %s could not be found" file)))
(bibtex-completion-normalize-bibliography))
(bibtex-completion-normalize-bibliography))
;; Pre-calculate minimal widths needed by the format strings for
;; various entry types:
@@ -479,9 +495,10 @@ for string replacement."
for entry-type = (parsebib-find-next-item)
while entry-type
if (string= (downcase entry-type) "string")
collect (let ((entry (parsebib-read-string (point) ht)))
collect (let ((entry (parsebib-read-string ht)))
(puthash (car entry) (cdr entry) ht)
entry))))
entry)
else do (forward-line 1))))
(-filter (lambda (x) x) strings)))
(defun bibtex-completion-update-strings-ht (ht strings)
@@ -669,8 +686,8 @@ If HT-STRINGS is provided it is assumed to be a hash table."
bibtex-completion-additional-search-fields))
for entry-type = (parsebib-find-next-item)
while entry-type
unless (member-ignore-case entry-type '("preamble" "string" "comment"))
collect (let* ((entry (parsebib-read-entry entry-type (point) ht-strings))
if (not (member-ignore-case entry-type '("preamble" "string" "comment")))
collect (let* ((entry (parsebib-read-entry nil ht-strings))
(fields (append
(list (if (assoc-string "author" entry 'case-fold)
"author"
@@ -681,7 +698,8 @@ If HT-STRINGS is provided it is assumed to be a hash table."
fields)))
(-map (lambda (it)
(cons (downcase (car it)) (cdr it)))
(bibtex-completion-prepare-entry entry fields)))))
(bibtex-completion-prepare-entry entry fields)))
else do (forward-line 1)))
(defun bibtex-completion-get-entry (entry-key)
"Given a BibTeX key this function scans all bibliographies listed in `bibtex-completion-bibliography' and returns an alist of the record with that key.
@@ -700,9 +718,10 @@ Fields from crossreferenced entries are appended to the requested entry."
"\\)[[:space:]]*[\(\{][[:space:]]*"
(regexp-quote entry-key) "[[:space:]]*,")
nil t)
(let ((entry-type (match-string 1)))
(progn
(goto-char (match-beginning 0))
(reverse (bibtex-completion-prepare-entry
(parsebib-read-entry entry-type (point) bibtex-completion-string-hash-table) nil do-not-find-pdf)))
(parsebib-read-entry nil bibtex-completion-string-hash-table) nil do-not-find-pdf)))
(progn
(display-warning :warning (concat "Bibtex-completion couldn't find entry with key \"" entry-key "\"."))
nil)))))
@@ -1213,14 +1232,21 @@ string if FIELD is not present in ENTRY and DEFAULT is nil."
"\\(^[^{]*{\\)\\|\\(}[^{]*{\\)\\|\\(}.*$\\)\\|\\(^[^{}]*$\\)"
(lambda (x) (downcase (s-replace "\\" "\\\\" x)))
value)))))
("booktitle" value)
("journal"
(replace-regexp-in-string "[{}]" "" value))
("booktitle"
(replace-regexp-in-string "[{}]" "" value))
;; Maintain the punctuation and capitalization that is used by
;; the journal in its title.
("pages" (s-join "" (s-split "[^0-9]+" value t)))
("doi" (s-concat " http://dx.doi.org/" value))
("year" (or value
(car (split-string (bibtex-completion-get-value "date" entry "") "-"))))
(_ value))))))
("year" value)
(_ value))
;; If field does not exist, try to retrieve value from
;; alternative field (possibly a biblatex field):
(pcase field
("year" (car (split-string (bibtex-completion-get-value "date" entry "") "-")))
("journal" (bibtex-completion-get-value "journaltitle" entry "")))))))
default ""))
(defun bibtex-completion-apa-format-authors (value &optional abbrev)
@@ -1300,18 +1326,9 @@ When ABBREV is non-nil, format in abbreviated APA style instead."
(bibtex-completion-apa-format-editors value t))
(defun bibtex-completion-get-value (field entry &optional default)
"Return the value for FIELD in ENTRY or DEFAULT if the value is not defined.
Surrounding curly braces are stripped."
"Return the value for FIELD in ENTRY or DEFAULT if the value is not defined."
(let ((value (cdr (assoc-string field entry 'case-fold))))
(if value
(replace-regexp-in-string
"\\(^[[:space:]]*[\"{][[:space:]]*\\)\\|\\([[:space:]]*[\"}][[:space:]]*$\\)"
""
;; Collapse whitespaces when the content is not a path:
(if (equal bibtex-completion-pdf-field field)
value
(s-collapse-whitespace value)))
default)))
(or value default)))
(defun bibtex-completion-insert-key (keys)
"Insert BibTeX KEYS at point."

View File

@@ -1,566 +0,0 @@
;;; bind-key.el --- A simple way to manage personal keybindings -*- lexical-binding: t; -*-
;; Copyright (c) 2012-2022 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Maintainer: John Wiegley <johnw@newartisans.com>
;; Created: 16 Jun 2012
;; Version: 2.4.1
;; Package-Version: 20221209.2013
;; Package-Commit: bcf0984cf55b70fe6896c6a15f61df92b24f8ffd
;; Package-Requires: ((emacs "24.3"))
;; Keywords: keys keybinding config dotemacs extensions
;; URL: https://github.com/jwiegley/use-package
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; If you have lots of keybindings set in your init file, it can be
;; hard to know which ones you haven't set yet, and which may now be
;; overriding some new default in a new Emacs version. This module
;; aims to solve that problem.
;;
;; Bind keys as follows in your init file:
;;
;; (bind-key "C-c x" 'my-ctrl-c-x-command)
;;
;; If the keybinding argument is a vector, it is passed straight to
;; `define-key', so remapping a key with `[remap COMMAND]' works as
;; expected:
;;
;; (bind-key [remap original-ctrl-c-x-command] 'my-ctrl-c-x-command)
;;
;; If you want the keybinding to override all minor modes that may also bind
;; the same key, use the `bind-key*' form:
;;
;; (bind-key* "<C-return>" 'other-window)
;;
;; If you want to rebind a key only in a particular keymap, use:
;;
;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map)
;;
;; To unbind a key within a keymap (for example, to stop your favorite major
;; mode from changing a binding that you don't want to override everywhere),
;; use `unbind-key':
;;
;; (unbind-key "C-c x" some-other-mode-map)
;;
;; To bind multiple keys at once, or set up a prefix map, a `bind-keys' macro
;; is provided. It accepts keyword arguments, please see its documentation
;; for a detailed description.
;;
;; To add keys into a specific map, use :map argument
;;
;; (bind-keys :map dired-mode-map
;; ("o" . dired-omit-mode)
;; ("a" . some-custom-dired-function))
;;
;; To set up a prefix map, use `:prefix-map' and `:prefix' arguments (both are
;; required)
;;
;; (bind-keys :prefix-map my-customize-prefix-map
;; :prefix "C-c c"
;; ("f" . customize-face)
;; ("v" . customize-variable))
;;
;; You can combine all the keywords together. Additionally,
;; `:prefix-docstring' can be specified to set documentation of created
;; `:prefix-map' variable.
;;
;; To bind multiple keys in a `bind-key*' way (to be sure that your bindings
;; will not be overridden by other modes), you may use `bind-keys*' macro:
;;
;; (bind-keys*
;; ("C-o" . other-window)
;; ("C-M-n" . forward-page)
;; ("C-M-p" . backward-page))
;;
;; After Emacs loads, you can see a summary of all your personal keybindings
;; currently in effect with this command:
;;
;; M-x describe-personal-keybindings
;;
;; This display will tell you if you've overridden a default keybinding, and
;; what the default was. Also, it will tell you if the key was rebound after
;; your binding it with `bind-key', and what it was rebound it to.
;;
;; See the `use-package' info manual for more information.
;;; Code:
(require 'cl-lib)
(require 'easy-mmode)
(defgroup bind-key nil
"A simple way to manage personal keybindings."
:group 'keyboard
:group 'convenience
:link '(emacs-commentary-link :tag "Commentary" "bind-key.el")
:version "29.1")
(defcustom bind-key-column-widths '(18 . 40)
"Width of columns in `describe-personal-keybindings'."
:type '(cons integer integer)
:group 'bind-key)
(defcustom bind-key-segregation-regexp
"\\`\\(\\(C-[chx] \\|M-[gso] \\)\\([CM]-\\)?\\|.+-\\)"
"Regexp used by \\[describe-personal-keybindings] to divide key sets."
:type 'regexp
:group 'bind-key)
(defcustom bind-key-describe-special-forms nil
"If non-nil, extract docstrings from lambdas, closures and keymaps if possible."
:type 'boolean
:group 'bind-key)
;; Create override-global-mode to force key remappings
(defvar override-global-map (make-keymap)
"Keymap for `override-global-mode'.")
(define-minor-mode override-global-mode
"A minor mode for allowing keybindings to override other modes.
The main purpose of this mode is to simplify bindings keys in
such a way that they take precedence over other modes.
To achieve this, the keymap `override-global-map' is added to
`emulation-mode-map-alists', which makes it take precedence over
keymaps in `minor-mode-map-alist'. Thereby, key bindings get an
even higher precedence than global key bindings defined with
`keymap-global-set' (or, in Emacs 28 or older, `global-set-key').
The macro `bind-key*' (which see) provides a convenient way to
add keys to that keymap."
:init-value t
:lighter "")
;; the keymaps in `emulation-mode-map-alists' take precedence over
;; `minor-mode-map-alist'
(add-to-list 'emulation-mode-map-alists
`((override-global-mode . ,override-global-map)))
(defvar personal-keybindings nil
"List of bindings performed by `bind-key'.
Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)")
;;;###autoload
(defmacro bind-key (key-name command &optional keymap predicate)
"Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed).
KEY-NAME may be a vector, in which case it is passed straight to
`define-key'. Or it may be a string to be interpreted as
spelled-out keystrokes, e.g., \"C-c C-z\". See the documentation
of `edmacro-mode' for details.
COMMAND must be an interactive function or lambda form.
KEYMAP, if present, should be a keymap variable or symbol.
For example:
(bind-key \"M-h\" #\\='some-interactive-function my-mode-map)
(bind-key \"M-h\" #\\='some-interactive-function \\='my-mode-map)
If PREDICATE is non-nil, it is a form evaluated to determine when
a key should be bound. It must return non-nil in such cases.
Emacs can evaluate this form at any time that it does redisplay
or operates on menu data structures, so you should write it so it
can safely be called at any time."
(let ((namevar (make-symbol "name"))
(keyvar (make-symbol "key"))
(kmapvar (make-symbol "kmap"))
(kdescvar (make-symbol "kdesc"))
(bindingvar (make-symbol "binding")))
`(let* ((,namevar ,key-name)
(,keyvar ,(if (stringp key-name) (read-kbd-macro key-name)
`(if (vectorp ,namevar) ,namevar
(read-kbd-macro ,namevar))))
(,kmapvar (or (if (and ,keymap (symbolp ,keymap))
(symbol-value ,keymap) ,keymap)
global-map))
(,kdescvar (cons (if (stringp ,namevar) ,namevar
(key-description ,namevar))
(if (symbolp ,keymap) ,keymap (quote ,keymap))))
(,bindingvar (lookup-key ,kmapvar ,keyvar)))
(let ((entry (assoc ,kdescvar personal-keybindings))
(details (list ,command
(unless (numberp ,bindingvar)
,bindingvar))))
(if entry
(setcdr entry details)
(add-to-list 'personal-keybindings (cons ,kdescvar details))))
,(if predicate
`(define-key ,kmapvar ,keyvar
'(menu-item "" nil :filter (lambda (&optional _)
(when ,predicate
,command))))
`(define-key ,kmapvar ,keyvar ,command)))))
;;;###autoload
(defmacro unbind-key (key-name &optional keymap)
"Unbind the given KEY-NAME, within the KEYMAP (if specified).
See `bind-key' for more details."
(let ((namevar (make-symbol "name"))
(kdescvar (make-symbol "kdesc")))
`(let* ((,namevar ,key-name)
(,kdescvar (cons (if (stringp ,namevar) ,namevar
(key-description ,namevar))
(if (symbolp ,keymap) ,keymap (quote ,keymap)))))
(bind-key--remove (if (vectorp ,namevar) ,namevar
(read-kbd-macro ,namevar))
(or (if (and ,keymap (symbolp ,keymap))
(symbol-value ,keymap) ,keymap)
global-map))
(setq personal-keybindings
(cl-delete-if (lambda (k) (equal (car k) ,kdescvar))
personal-keybindings))
nil)))
(defun bind-key--remove (key keymap)
"Remove KEY from KEYMAP.
In contrast to `define-key', this function removes the binding from the keymap."
(define-key keymap key nil)
;; Split M-key in ESC key
(setq key (cl-mapcan (lambda (k)
(if (and (integerp k) (/= (logand k ?\M-\0) 0))
(list ?\e (logxor k ?\M-\0))
(list k)))
key))
;; Delete single keys directly
(if (= (length key) 1)
(delete key keymap)
;; Lookup submap and delete key from there
(let* ((prefix (vconcat (butlast key)))
(submap (lookup-key keymap prefix)))
(unless (keymapp submap)
(error "Not a keymap for %s" key))
(when (symbolp submap)
(setq submap (symbol-function submap)))
(delete (last key) submap)
;; Delete submap if it is empty
(when (= 1 (length submap))
(bind-key--remove prefix keymap)))))
;;;###autoload
(defmacro bind-key* (key-name command &optional predicate)
"Similar to `bind-key', but overrides any mode-specific bindings."
`(bind-key ,key-name ,command override-global-map ,predicate))
(defun bind-keys-form (args keymap)
"Bind multiple keys at once.
Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings
:prefix-docstring STR - docstring for the prefix-map variable
:menu-name NAME - optional menu string for prefix map
:repeat-docstring STR - docstring for the repeat-map variable
:repeat-map MAP - name of the repeat map that should be created
for these bindings. If specified, the
`repeat-map' property of each command bound
(within the scope of the `:repeat-map' keyword)
is set to this map.
:exit BINDINGS - Within the scope of `:repeat-map' will bind the
key in the repeat map, but will not set the
`repeat-map' property of the bound command.
:continue BINDINGS - Within the scope of `:repeat-map' forces the
same behaviour as if no special keyword had
been used (that is, the command is bound, and
it's `repeat-map' property set)
:filter FORM - optional form to determine when bindings apply
The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(let (map
prefix-doc
prefix-map
prefix
repeat-map
repeat-doc
repeat-type ;; Only used internally
filter
menu-name
pkg)
;; Process any initial keyword arguments
(let ((cont t)
(arg-change-func 'cddr))
(while (and cont args)
(if (cond ((and (eq :map (car args))
(not prefix-map))
(setq map (cadr args)))
((eq :prefix-docstring (car args))
(setq prefix-doc (cadr args)))
((and (eq :prefix-map (car args))
(not (memq map '(global-map
override-global-map))))
(setq prefix-map (cadr args)))
((eq :repeat-docstring (car args))
(setq repeat-doc (cadr args)))
((and (eq :repeat-map (car args))
(not (memq map '(global-map
override-global-map))))
(setq repeat-map (cadr args))
(setq map repeat-map))
((eq :continue (car args))
(setq repeat-type :continue
arg-change-func 'cdr))
((eq :exit (car args))
(setq repeat-type :exit
arg-change-func 'cdr))
((eq :prefix (car args))
(setq prefix (cadr args)))
((eq :filter (car args))
(setq filter (cadr args)) t)
((eq :menu-name (car args))
(setq menu-name (cadr args)))
((eq :package (car args))
(setq pkg (cadr args))))
(setq args (funcall arg-change-func args))
(setq cont nil))))
(when (or (and prefix-map (not prefix))
(and prefix (not prefix-map)))
(error "Both :prefix-map and :prefix must be supplied"))
(when repeat-type
(unless repeat-map
(error ":continue and :exit require specifying :repeat-map")))
(when (and menu-name (not prefix))
(error "If :menu-name is supplied, :prefix must be too"))
(unless map (setq map keymap))
;; Process key binding arguments
(let (first next)
(while args
(if (keywordp (car args))
(progn
(setq next args)
(setq args nil))
(if first
(nconc first (list (car args)))
(setq first (list (car args))))
(setq args (cdr args))))
(cl-flet
((wrap (map bindings)
(if (and map pkg (not (memq map '(global-map
override-global-map))))
`((if (boundp ',map)
,(macroexp-progn bindings)
(eval-after-load
,(if (symbolp pkg) `',pkg pkg)
',(macroexp-progn bindings))))
bindings)))
(append
(when prefix-map
`((defvar ,prefix-map)
,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
,@(if menu-name
`((define-prefix-command ',prefix-map nil ,menu-name))
`((define-prefix-command ',prefix-map)))
,@(if (and map (not (eq map 'global-map)))
(wrap map `((bind-key ,prefix ',prefix-map ,map ,filter)))
`((bind-key ,prefix ',prefix-map nil ,filter)))))
(when repeat-map
`((defvar ,repeat-map (make-sparse-keymap)
,@(when repeat-doc `(,repeat-doc)))))
(wrap map
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if prefix-map
`((bind-key ,(car form) ,fun ,prefix-map ,filter))
(if (and map (not (eq map 'global-map)))
;; Only needed in this branch, since when
;; repeat-map is non-nil, map is always
;; non-nil
`(,@(when (and repeat-map (not (eq repeat-type :exit)))
`((put ,fun 'repeat-map ',repeat-map)))
(bind-key ,(car form) ,fun ,map ,filter))
`((bind-key ,(car form) ,fun nil ,filter))))))
first))
(when next
(bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map))
,@(if pkg
(cons :package (cons pkg next))
next)) map)))))))
;;;###autoload
(defmacro bind-keys (&rest args)
"Bind multiple keys at once.
Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings
:prefix-docstring STR - docstring for the prefix-map variable
:menu-name NAME - optional menu string for prefix map
:repeat-docstring STR - docstring for the repeat-map variable
:repeat-map MAP - name of the repeat map that should be created
for these bindings. If specified, the
`repeat-map' property of each command bound
(within the scope of the `:repeat-map' keyword)
is set to this map.
:exit BINDINGS - Within the scope of `:repeat-map' will bind the
key in the repeat map, but will not set the
`repeat-map' property of the bound command.
:continue BINDINGS - Within the scope of `:repeat-map' forces the
same behaviour as if no special keyword had
been used (that is, the command is bound, and
it's `repeat-map' property set)
:filter FORM - optional form to determine when bindings apply
The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(macroexp-progn (bind-keys-form args nil)))
;;;###autoload
(defmacro bind-keys* (&rest args)
"Bind multiple keys at once, in `override-global-map'.
Accepts the same keyword arguments as `bind-keys' (which see).
This binds keys in such a way that bindings are not overridden by
other modes. See `override-global-mode'."
(macroexp-progn (bind-keys-form args 'override-global-map)))
(defun get-binding-description (elem)
(cond
((listp elem)
(cond
((memq (car elem) '(lambda function))
(if (and bind-key-describe-special-forms
(stringp (nth 2 elem)))
(nth 2 elem)
"#<lambda>"))
((eq 'closure (car elem))
(if (and bind-key-describe-special-forms
(stringp (nth 3 elem)))
(nth 3 elem)
"#<closure>"))
((eq 'keymap (car elem))
"#<keymap>")
(t
elem)))
;; must be a symbol, non-symbol keymap case covered above
((and bind-key-describe-special-forms (keymapp elem))
(let ((doc (get elem 'variable-documentation)))
(if (stringp doc) doc elem)))
((symbolp elem)
elem)
(t
"#<byte-compiled lambda>")))
(defun compare-keybindings (l r)
(let* ((regex bind-key-segregation-regexp)
(lgroup (and (string-match regex (caar l))
(match-string 0 (caar l))))
(rgroup (and (string-match regex (caar r))
(match-string 0 (caar r))))
(lkeymap (cdar l))
(rkeymap (cdar r)))
(cond
((and (null lkeymap) rkeymap)
(cons t t))
((and lkeymap (null rkeymap))
(cons nil t))
((and lkeymap rkeymap
(not (string= (symbol-name lkeymap) (symbol-name rkeymap))))
(cons (string< (symbol-name lkeymap) (symbol-name rkeymap)) t))
((and (null lgroup) rgroup)
(cons t t))
((and lgroup (null rgroup))
(cons nil t))
((and lgroup rgroup)
(if (string= lgroup rgroup)
(cons (string< (caar l) (caar r)) nil)
(cons (string< lgroup rgroup) t)))
(t
(cons (string< (caar l) (caar r)) nil)))))
;;;###autoload
(defun describe-personal-keybindings ()
"Display all the personal keybindings defined by `bind-key'."
(interactive)
(with-output-to-temp-buffer "*Personal Keybindings*"
(princ (format (concat "Key name%s Command%s Comments\n%s %s "
"---------------------\n")
(make-string (- (car bind-key-column-widths) 9) ? )
(make-string (- (cdr bind-key-column-widths) 8) ? )
(make-string (1- (car bind-key-column-widths)) ?-)
(make-string (1- (cdr bind-key-column-widths)) ?-)))
(let (last-binding)
(dolist (binding
(setq personal-keybindings
(sort personal-keybindings
(lambda (l r)
(car (compare-keybindings l r))))))
(if (not (eq (cdar last-binding) (cdar binding)))
(princ (format "\n\n%s: %s\n%s\n\n"
(cdar binding) (caar binding)
(make-string (+ 21 (car bind-key-column-widths)
(cdr bind-key-column-widths)) ?-)))
(if (and last-binding
(cdr (compare-keybindings last-binding binding)))
(princ "\n")))
(let* ((key-name (caar binding))
(at-present (lookup-key (or (symbol-value (cdar binding))
(current-global-map))
(read-kbd-macro key-name)))
(command (nth 1 binding))
(was-command (nth 2 binding))
(command-desc (get-binding-description command))
(was-command-desc (and was-command
(get-binding-description was-command)))
(at-present-desc (get-binding-description at-present)))
(let ((line
(format
(format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths)
(cdr bind-key-column-widths))
key-name (format "`%s\'" command-desc)
(if (string= command-desc at-present-desc)
(if (or (null was-command)
(string= command-desc was-command-desc))
""
(format "was `%s\'" was-command-desc))
(format "[now: `%s\']" at-present)))))
(princ (if (string-match "[ \t]+\n" line)
(replace-match "\n" t t line)
line))))
(setq last-binding binding)))))
(provide 'bind-key)
;; Local Variables:
;; outline-regexp: ";;;\\(;* [^\s\t\n]\\|###autoload\\)\\|("
;; End:
;;; bind-key.el ends here

12
lisp/cfrs/cfrs-pkg.el Normal file
View File

@@ -0,0 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cfrs" "20220129.1149"
"Child-frame based read-string."
'((emacs "26.1")
(dash "2.11.0")
(s "1.10.0")
(posframe "0.6.0"))
:url "https://github.com/Alexander-Miller/cfrs"
:commit "f3a21f237b2a54e6b9f8a420a9da42b4f0a63121"
:revdesc "f3a21f237b2a"
:authors '(("Alexander Miller" . "alexanderm@web.de"))
:maintainers '(("Alexander Miller" . "alexanderm@web.de")))

View File

@@ -4,9 +4,8 @@
;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((emacs "26.1") (dash "2.11.0") (s "1.10.0") (posframe "0.6.0"))
;; Package-Commit: f3a21f237b2a54e6b9f8a420a9da42b4f0a63121
;; Package-Version: 20220129.1149
;; Package-X-Original-Version: 1.6.0
;; Package-Revision: f3a21f237b2a
;; Homepage: https://github.com/Alexander-Miller/cfrs
;; This program is free software; you can redistribute it and/or modify

View File

@@ -26,6 +26,8 @@
;;; Code:
(require 'parse-time)
(require 'compat)
(require 'citeproc-bibtex)
(defvar citeproc-blt-to-csl-types-alist
@@ -473,7 +475,7 @@ biblatex variables in B."
(citeproc-blt--get-standard 'address b)))
(push (cons csl-place-var ~location) result)))
;; url
(-when-let (url (or (let ((u (alist-get 'url b))) (and u (citeproc-s-replace "\\" "" u)))
(-when-let (url (or (let ((u (alist-get 'url b))) (and u (string-replace "\\" "" u)))
(when-let ((~eprinttype (or (alist-get 'eprinttype b)
(alist-get 'archiveprefix b)))
(~eprint (alist-get 'eprint b))

View File

@@ -32,6 +32,7 @@
(require 's)
(require 'org)
(require 'map)
(require 'compat)
;; Handle the fact that org-bibtex has been renamed to ol-bibtex -- for the time
;; being we support both feature names.
(or (require 'ol-bibtex nil t)
@@ -262,7 +263,7 @@ replacements."
(let ((wo-quotes (if (and (string= (substring s 0 1) "\"")
(string= (substring s -1) "\""))
(substring s 1 -1) s)))
(citeproc-s-replace "\\&" "&" wo-quotes)))
(string-replace "\\&" "&" wo-quotes)))
(defun citeproc-bt--to-csl (s &optional with-nocase)
"Convert a BibTeX field S to a CSL one.

View File

@@ -1,6 +1,6 @@
;;; citeproc-cite.el --- cite and citation rendering -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2021 András Simonyi
;; Copyright (C) 2017-2024 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
@@ -40,6 +40,11 @@
(require 'citeproc-formatters)
(require 'citeproc-sort)
(require 'citeproc-subbibs)
(require 'citeproc-date)
(require 'citeproc-biblatex)
(declare-function citeproc-style-category "citeproc-style" (style))
(cl-defstruct (citeproc-citation (:constructor citeproc-citation-create))
"A struct representing a citation.
@@ -77,6 +82,35 @@ Each function takes a single argument, a rich-text, and returns a
post-processed rich-text value. The functions are applied in the
order they appear in the list.")
(defun citeproc-cite--parse-locator-extra (s)
"Parse extra locator text S into locator-date and locator-extra.
Return a pair (LOCATOR-DATE . LOCATOR-EXTRA) where
- LOCATOR-DATE is a `citeproc-date' struct or nil, and
- LOCATOR-EXTRA is a string or nil."
(let (locator-date locator-extra)
(if (not (string-match-p "^[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" s))
(setq locator-extra (and (not (s-blank-str-p s)) s))
(setq locator-date (citeproc-date-parse (citeproc-blt--to-csl-date
(substring s 0 10))))
(let ((extra (substring s 10)))
(unless (s-blank-str-p extra) (setq locator-extra extra))))
(cons locator-date locator-extra)))
(defun citeproc-cite--internalize-locator (cite)
"Internalize a CITE struct's locator by parsing it into fields.
If the \"|\" separator is present in the locator then parse it
into `locator', `locator-extra' and `locator-date', and update
CITE with these fields accordingly. Returns the possibly modified
CITE."
(when-let ((locator (alist-get 'locator cite))
(separator-pos (cl-position ?| locator)))
(setf (alist-get 'locator cite) (substring locator 0 separator-pos))
(pcase-let ((`(,locator-date . ,locator-extra) (citeproc-cite--parse-locator-extra
(substring locator (1+ separator-pos)))))
(when locator-date (push (cons 'locator-date locator-date) cite))
(when locator-extra (push (cons 'locator-extra locator-extra) cite))))
cite)
(defun citeproc-cite--varlist (cite)
"Return the varlist belonging to CITE."
(let* ((itd (alist-get 'itd cite))
@@ -87,7 +121,8 @@ order they appear in the list.")
'(label locator suppress-author suppress-date
stop-rendering-at position near-note
first-reference-note-number ignore-et-al
bib-entry locator-only use-short-title))
bib-entry locator-only use-short-title
locator-extra locator-date))
cite)))
(nconc cite-vv item-vv)))
@@ -141,7 +176,7 @@ links else). For legacy reasons, any other value is treated as
;; Add cite prefix and suffix
(when (s-present-p plain-suff)
(push (citeproc-rt-from-str suff) result)
(unless (= (aref plain-suff 0) ?\s)
(unless (memql (aref plain-suff 0) '(?, ?\s))
(push " " result)))
(push rendered-varlist result)
(when (s-present-p plain-pref)
@@ -228,7 +263,8 @@ For the optional INTERNAL-LINKS argument see
(when outer-attrs
(setq result (list outer-attrs result)))
;; Prepend author to textual citations
(when (eq (citeproc-citation-mode c) 'textual)
(when (and (eq (citeproc-citation-mode c) 'textual)
(not (member (citeproc-style-category style) '("numeric" "label"))))
(let* ((first-elt (car cites)) ;; First elt is either a cite or a cite group.
;; If the latter then we need to locate the
;; first cite as the 2nd element of the first
@@ -237,11 +273,11 @@ For the optional INTERNAL-LINKS argument see
(cadr first-elt)
first-elt))
(author-cite
(append '((suppress-author . nil) (stop-rendering-at . names))
first-cite))
(append '((suppress-author . nil) (stop-rendering-at . names)
(prefix) (suffix) (locator))
first-cite))
(rendered-author (citeproc-cite--render author-cite style 'no-links)))
(when (and (listp rendered-author)
(alist-get 'stopped-rendering (car rendered-author)))
(when (listp rendered-author)
(setq result `(nil ,rendered-author " " ,result)))))
;; Capitalize first
(when (citeproc-citation-capitalize-first c)
@@ -548,6 +584,7 @@ Possible values are `last', `first' and `subsequent'.")
(unless (citeproc-proc-finalized proc)
(citeproc-proc-process-uncited proc)
(citeproc-sb-add-subbib-info proc)
(citeproc-sb-prune-unrendered proc)
(citeproc-proc-update-sortkeys proc)
(citeproc-proc-sort-itds proc)
(citeproc-proc-update-positions proc)

View File

@@ -168,16 +168,6 @@ TYPED RTS is a list of (RICH-TEXT . TYPE) pairs"
"Return the first text associated with TERM in CONTEXT."
(citeproc-term-text-from-terms term (citeproc-context-terms context)))
(defun citeproc-term-inflected-text (term form number context)
"Return the text associated with TERM having FORM and NUMBER."
(let ((matches
(--select (string= term (citeproc-term-name it))
(citeproc-context-terms context))))
(cond ((not matches) nil)
((= (length matches) 1)
(citeproc-term-text (car matches)))
(t (citeproc-term--inflected-text-1 matches form number)))))
(defconst citeproc--term-form-fallback-alist
'((verb-short . verb)
(symbol . short)
@@ -185,17 +175,21 @@ TYPED RTS is a list of (RICH-TEXT . TYPE) pairs"
(short . long))
"Alist containing the fallback form for each term form.")
(defun citeproc-term--inflected-text-1 (matches form number)
(let ((match (--first (and (eq form (citeproc-term-form it))
(or (not (citeproc-term-number it))
(eq number (citeproc-term-number it))))
matches)))
(if match
(citeproc-term-text match)
(citeproc-term--inflected-text-1
matches
(alist-get form citeproc--term-form-fallback-alist)
number))))
(defun citeproc-term-inflected-text (term form number context)
"Return the text associated with TERM having FORM and NUMBER."
(let ((matches
(--select (string= term (citeproc-term-name it))
(citeproc-context-terms context))))
(if (not matches) nil
(let (match)
(while (and (not match) form)
(setq match (--first (and (eq form (citeproc-term-form it))
(or (not (citeproc-term-number it))
(eq number (citeproc-term-number it))))
matches))
(unless match
(setq form (alist-get form citeproc--term-form-fallback-alist))))
(when match (citeproc-term-text match))))))
(defun citeproc-term-get-gender (term context)
"Return the gender of TERM or nil if none is given."
@@ -224,6 +218,20 @@ no internal links should be produced."
;; Else link each cite to the corresponding bib item.
(if (eq mode 'cite) 'cited-item-no 'bib-item-no)))))
(defun citeproc-context-maybe-stop-rendering
(trigger context result &optional var)
"Stop rendering if a (`stop-rendering-at'. TRIGGER) pair is present in CONTEXT.
In case of stopping return with RESULT. If the optional VAR
symbol is non-nil then rendering is stopped only if VAR is eq to
TRIGGER."
(if (and (eq trigger (alist-get 'stop-rendering-at (citeproc-context-vars context)))
(or (not var) (eq var trigger))
(eq (cdr result) 'present-var))
(let ((rt-result (car result)))
(push '(stopped-rendering . t) (car rt-result))
(throw 'stop-rendering (citeproc-rt-render-affixes rt-result)))
result))
(defun citeproc-render-varlist-in-rt (var-alist style mode render-mode &optional
internal-links no-external-links)
"Render an item described by VAR-ALIST with STYLE in rich-text.
@@ -263,7 +271,7 @@ external links."
(citeproc-context-int-link-attrval
style internal-links mode (alist-get 'position var-alist)))
(cite-no-attr-val (cons cite-no-attr
(alist-get 'citation-number var-alist))))
(alist-get 'citation-number var-alist))))
(cond ((consp rendered) (setf (car rendered)
(-snoc (car rendered) cite-no-attr-val)))
((stringp rendered) (setq rendered

View File

@@ -34,6 +34,7 @@
(require 'citeproc-lib)
(require 'citeproc-rt)
(require 'citeproc-context)
(require 'citeproc-number)
(cl-defstruct (citeproc-date (:constructor citeproc-date-create))
"Struct for representing dates.
@@ -94,7 +95,7 @@ Set the remaining slots to the values SEASON and CIRCA."
(cons nil 'empty-vars)))
(cons nil 'empty-vars))))
;; Handle `year' citation mode by stopping if needed
(citeproc-lib-maybe-stop-rendering 'issued context result var-sym)))
(citeproc-context-maybe-stop-rendering 'issued context result var-sym)))
(defun citeproc--date-part (attrs _context &rest _body)
"Function corresponding to the date-part CSL element."

View File

@@ -33,8 +33,11 @@
(require 's)
(require 'cl-lib)
(cl-defstruct (citeproc-formatter (:constructor citeproc-formatter-create))
"Output formatter struct with slots RT, CITE, BIB-ITEM and BIB.
(require 'citeproc-s)
(require 'citeproc-rt)
(cl-defstruct (citeproc-formatter (:constructor citeproc-formatter-create))
"Output formatter struct with slots RT, CITE, BIB-ITEM and BIB.
RT is a one-argument function mapping a rich-text to its
formatted version,
CITE is a one-argument function mapping the output of RT for a
@@ -48,9 +51,9 @@ BIB is a two-argument function mapping a list of formatted
bibliography,
NO-EXTERNAL-LINKS is non-nil if the formatter doesn't support
external linking."
rt (cite #'identity) (bib-item (lambda (x _) x))
(bib (lambda (x _) (mapconcat #'identity x "\n\n")))
(no-external-links nil))
rt (cite #'identity) (bib-item (lambda (x _) x))
(bib (lambda (x _) (mapconcat #'identity x "\n\n")))
(no-external-links nil))
(defun citeproc-formatter-fun-create (fmt-alist)
"Return a rich-text formatter function based on FMT-ALIST.
@@ -164,11 +167,18 @@ Performs finalization by removing unnecessary zero-width spaces."
(setq result (citeproc-s-replace-all-seq
result '((" " . " ") (" " . " ") ("," . ",") (";" . ";")
(":" . ":") ("." . "."))))
;; Starting and ending z-w spaces are also removed.
(when (= (aref result 0) 8203)
;; Starting and ending z-w spaces are also removed, but not before an asterisk
;; to avoid creating an Org heading.
(when (and (= (aref result 0) 8203)
(not (= (aref result 1) ?*)))
(setq result (substring result 1)))
(when (= (aref result (- (length result) 1)) 8203)
(setq result (substring result 0 -1))))
(setq result (substring result 0 -1)))
;; Prepend a zero width no-break space when the text starts with
;; superscript to make Org parse it correctly.
;; NOTE: This is a workaround, ideally should be fixed in Org.
(when (= (aref result 0) ?^)
(setq result (concat "" result))))
result))
;; HTML
@@ -255,11 +265,16 @@ CSL tests."
"Return the LaTeX-escaped version of string S."
(replace-regexp-in-string citeproc-fmt--latex-esc-regex "\\\\\\&" s))
(defconst citeproc-fmt--latex-uri-esc-regex
(regexp-opt '("#" "%"))
"Regular expression matching characters to be escaped in URIs for LaTeX output.")
(defun citeproc-fmt--latex-href (text uri)
(let ((escaped-uri (replace-regexp-in-string "%" "\\\\%" uri)))
(if (string-prefix-p "http" text)
(concat "\\url{" escaped-uri "}")
(concat "\\href{" escaped-uri "}{" text "}"))))
(let ((escaped-uri (replace-regexp-in-string
citeproc-fmt--latex-uri-esc-regex "\\\\\\&" uri)))
(if (string-prefix-p "http" text)
(concat "\\url{" escaped-uri "}")
(concat "\\href{" escaped-uri "}{" text "}"))))
(defconst citeproc-fmt--latex-alist
`((unformatted . ,#'citeproc-fmt--latex-escape)
@@ -371,7 +386,9 @@ CSL tests."
:rt (citeproc-formatter-fun-create citeproc-fmt--org-latex-alist)
:bib #'citeproc-fmt--org-latex-bib-formatter))
(latex . ,(citeproc-formatter-create
:rt (citeproc-formatter-fun-create citeproc-fmt--latex-alist)))
:rt (citeproc-formatter-fun-create citeproc-fmt--latex-alist)
:bib (lambda (x _) (concat (mapconcat #'identity x "\n\n")
"\\bigskip"))))
(plain . ,(citeproc-formatter-create :rt #'citeproc-rt-to-plain
:no-external-links t)))
"Alist mapping supported output formats to formatter structs.")

View File

@@ -143,7 +143,7 @@
(setq type (cdr macro-val)))))
;; We stop if only the title had to be rendered.
(let ((result (cons (citeproc-rt-format-single attrs content context) type)))
(citeproc-lib-maybe-stop-rendering
(citeproc-context-maybe-stop-rendering
'title context result (or (and .variable (intern .variable)) t))))))
(provide 'citeproc-generic-elements)

View File

@@ -45,9 +45,10 @@ OCCURRED-BEFORE is used during bibliography generation to
DISAMB-POS contains the position on which cite disambiguation is
based. Possible values are 'first, 'ibid and 'subsequent,
SUBBIB-NOS is a list of numeric indexes of sub-bibliographies
in which the item occurs."
in which the item occurs,
UNCITED is t iff the item has no associated citation."
varvals rawcite rawbibitem rc-uptodate sort-key occurred-before
disamb-pos subbib-nos)
disamb-pos subbib-nos uncited)
(defun citeproc-itd-getvar (itd var)
"Return itemdata ITD's value for VAR ."

View File

@@ -38,7 +38,7 @@
)
(defconst citeproc--date-vars
'(accessed available-date event-date issued original-date submitted)
'(accessed available-date event-date issued original-date submitted locator-date)
"CSL date variables.")
(defconst citeproc--name-vars
@@ -145,20 +145,6 @@ numeric content."
(s-matches-p "\\`[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\(\\( *\\([,&-]\\|--\\) *\\)?[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)?\\'"
val))))
(defun citeproc-lib-maybe-stop-rendering
(trigger context result &optional var)
"Stop rendering if a (`stop-rendering-at'. TRIGGER) pair is present in CONTEXT.
In case of stopping return with RESULT. If the optional VAR
symbol is non-nil then rendering is stopped only if VAR is eq to
TRIGGER."
(if (and (eq trigger (alist-get 'stop-rendering-at (citeproc-context-vars context)))
(or (not var) (eq var trigger))
(eq (cdr result) 'present-var))
(let ((rt-result (car result)))
(push '(stopped-rendering . t) (car rt-result))
(throw 'stop-rendering (citeproc-rt-render-affixes rt-result)))
result))
(provide 'citeproc-lib)
;;; citeproc-lib.el ends here

View File

@@ -1,19 +1,18 @@
(define-package "citeproc" "20221216.1238" "A CSL 1.0.2 Citation Processor"
'((emacs "26")
(dash "2.13.0")
(s "1.12.0")
(f "0.18.0")
(queue "0.2")
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "citeproc" "20250525.1011"
"A CSL 1.0.2 Citation Processor."
'((emacs "26")
(dash "2.13.0")
(s "1.12.0")
(f "0.18.0")
(queue "0.2")
(string-inflection "1.0")
(org "9")
(parsebib "2.4"))
:commit "3cb83db147bdda208520246e82dbf9878fa3cbd0" :authors
'(("András Simonyi" . "andras.simonyi@gmail.com"))
:maintainer
'("András Simonyi" . "andras.simonyi@gmail.com")
:keywords
'("bib")
:url "https://github.com/andras-simonyi/citeproc-el")
;; Local Variables:
;; no-byte-compile: t
;; End:
(org "9")
(parsebib "2.4")
(compat "28.1"))
:url "https://github.com/andras-simonyi/citeproc-el"
:commit "e3bf1f80bcd64edf4afef564c0d94d38aa567d61"
:revdesc "e3bf1f80bcd6"
:keywords '("bib")
:authors '(("András Simonyi" . "andras.simonyi@gmail.com"))
:maintainers '(("András Simonyi" . "andras.simonyi@gmail.com")))

View File

@@ -25,6 +25,8 @@
;;; Code:
(require 'citeproc-s)
(defun citeproc-prange--end-significant (start end len)
"Return the significant digits of the end in page range START END.
START and END are strings of equal length containing integers. If

View File

@@ -99,11 +99,11 @@ sorted."
(push (cons 'editor-translator editor) result))
result))
(defun citeproc-proc--put-item (proc item itemid)
(defun citeproc-proc--put-item (proc item itemid &optional uncited)
"Put parsed csl-json ITEM with ITEMID into PROC.
Return the added itemdata structure."
(let* ((int-vars (citeproc-proc--internalize-item proc item))
(itemdata (citeproc-itemdata-create :varvals int-vars :rc-uptodate nil)))
(itemdata (citeproc-itemdata-create :varvals int-vars :uncited uncited)))
(citeproc-proc-put-itd-put itemid itemdata proc)
(citeproc-itd-setvar itemdata 'citation-number
(number-to-string (hash-table-count
@@ -150,7 +150,7 @@ Return the itemdata struct that was added."
(citeproc-proc--put-item
proc
(or item `((unprocessed-with-id . ,id)))
id))))))
id t))))))
(defun citeproc-proc-delete-occurrence-info (proc)
"Remove all itemdata occurrence info from PROC."
@@ -225,6 +225,19 @@ Return the PROC-internal representation of REP."
(when bib-sort (setf (citeproc-style-bib-sort style) (byte-compile bib-sort)))
(when cite-sort (setf (citeproc-style-cite-sort style) (byte-compile cite-sort)))))
(defun citeproc-proc-filtered-bib-p (proc)
"Return whether PROC has nontrivial filters"
(let ((filters (citeproc-proc-bib-filters proc)))
(and filters (not (equal filters '(nil))))))
(defun citeproc-proc-max-offset (itds)
"Return the maximal first field width of bibitems in ITDS.
ITDS should be the value of the itemdata field of a citeproc-proc
structure."
(cl-loop for itd being the hash-values of itds
when (listp (citeproc-itemdata-rawbibitem itd)) maximize
(length (citeproc-rt-to-plain (cadr (citeproc-itemdata-rawbibitem itd))))))
(provide 'citeproc-proc)
;;; citeproc-proc.el ends here

View File

@@ -36,6 +36,7 @@
(require 'cl-lib)
(require 'let-alist)
(require 's)
(require 'compat)
(require 'citeproc-s)
(require 'citeproc-lib)
@@ -148,7 +149,7 @@ If optional SKIP-NOCASE is non-nil then skip spans with the
(defun citeproc-rt-strip-periods (rts)
"Remove all periods from rich-texts RTS."
(citeproc-rt-map-strings (lambda (x) (citeproc-s-replace "." "" x)) rts))
(citeproc-rt-map-strings (lambda (x) (string-replace "." "" x)) rts))
(defun citeproc-rt-length (rt)
"Return the length of rich-text RT as a string."
@@ -263,7 +264,9 @@ on any dominated branch for which PRED holds."
(if (and s (s-matches-p "</[[:alnum:]]+>" s))
(let* ((parsed (citeproc-lib-parse-html-frag s))
(body (cddr (cl-caddr parsed)))
(stripped (if (eq (caar body) 'p) (cl-cddar body) body)))
(stripped (if (and (consp (car body)) (eq (caar body) 'p))
(cl-cddar body)
body)))
(if (= 1 (length stripped))
(citeproc-rt-from-html (car stripped))
(cons nil (mapcar 'citeproc-rt-from-html stripped))))
@@ -532,12 +535,6 @@ The values are ordered depth-first."
;;; Helpers for bibliography rendering
(defun citeproc-rt-max-offset (itemdata)
"Return the maximal first field width in rich-texts RTS."
(cl-loop for itd being the hash-values of itemdata
when (listp (citeproc-itemdata-rawbibitem itd)) maximize
(length (citeproc-rt-to-plain (cadr (citeproc-itemdata-rawbibitem itd))))))
(defun citeproc-rt-subsequent-author-substitute (bib s)
"Substitute S for subsequent author(s) in BIB.
BIB is a list of bib entries in rich-text format. Return the

View File

@@ -27,11 +27,7 @@
(require 'thingatpt)
(require 's)
;; Handle the unavailability of `string-replace' in early Emacs versions
(if (fboundp 'string-replace)
(defalias 'citeproc-s-replace #'string-replace)
(defalias 'citeproc-s-replace #'s-replace))
(require 'compat)
(defun citeproc-s-camelcase-p (s)
"Return whether string S is in camel case."
@@ -151,12 +147,12 @@ first word is not in lowercase then return S."
(buffer-string))
s))
(defun citeproc-s-sentence-case-title (s omit-nocase)
(defun citeproc-s-sentence-case-title (s &optional omit-nocase)
"Return a sentence-cased version of title string S.
If optional OMIT-NOCASE is non-nil then omit the nocase tags from the output."
(if (s-blank-p s) s
(let ((sliced (citeproc-s-slice-by-matches
s "\\(<span class=\"nocase\">\\|</span>\\|: +\\w\\)"))
s "\\(<span class=\"nocase\">\\|</span>\\|: +[\"'“‘]*[[:alpha:]]\\)"))
(protect-level 0)
(first t)
result)
@@ -165,13 +161,18 @@ If optional OMIT-NOCASE is non-nil then omit the nocase tags from the output."
(pcase slice
("<span class=\"nocase\">" (cl-incf protect-level) (if omit-nocase nil slice))
("</span>" (cl-decf protect-level) (if omit-nocase nil slice))
;; Don't touch the first letter after a colon since it is probably a subtitle.
((pred (string-match-p "^:")) slice)
;; Don't touch the first letter after a colon since it probably
;; starts a subtitle.
((pred (string-match-p "^: +[\"'“‘]*[[:alpha:]]")) (setq first nil) slice)
(_ (cond ((< 0 protect-level) (setq first nil) slice)
((not first) (downcase slice))
(t (setq first nil)
(concat (upcase (substring slice 0 1))
(downcase (substring slice 1)))))))
;; We upcase the first letter and downcase the rest.
(let ((pos (string-match "[[:alpha:]]" slice)))
(if pos (concat (substring slice 0 pos)
(upcase (substring slice pos (1+ pos)))
(downcase (substring slice (1+ pos))))
slice))))))
result))
(apply #'concat (nreverse result)))))
@@ -232,7 +233,7 @@ OQ is the opening quote, CQ is the closing quote to use."
REPLACEMENTS is an alist with (FROM . TO) elements."
(let ((result s))
(pcase-dolist (`(,from . ,to) replacements)
(setq result (citeproc-s-replace from to result)))
(setq result (string-replace from to result)))
result))
(defun citeproc-s-replace-all-sim (s regex replacements)

View File

@@ -36,6 +36,7 @@
(require 'citeproc-macro)
(require 'citeproc-proc)
(require 'citeproc-name)
(require 'citeproc-number)
(defun citeproc--sort (_attrs _context &rest body)
"Placeholder function corresponding to the cs:sort element of CSL."
@@ -169,20 +170,20 @@ MODE is either `cite' or `bib'."
(defun citeproc-proc-sort-itds (proc)
"Sort the itemdata in PROC."
(let ((sorted-bib-p (citeproc-style-bib-sort (citeproc-proc-style proc)))
(filters (citeproc-proc-bib-filters proc)))
(when (or sorted-bib-p filters)
(let* ((itds (hash-table-values (citeproc-proc-itemdata proc)))
(sorted (if sorted-bib-p
(let ((sort-orders (citeproc-style-bib-sort-orders
(let ((is-sorted-bib (citeproc-style-bib-sort (citeproc-proc-style proc)))
(is-filtered (citeproc-proc-filtered-bib-p proc)))
(when (or is-sorted-bib is-filtered)
(let* ((itds (citeproc-sort-itds-on-citnum
(hash-table-values (citeproc-proc-itemdata proc)))))
(when is-sorted-bib
(let ((sort-orders (citeproc-style-bib-sort-orders
(citeproc-proc-style proc))))
(citeproc-sort-itds itds sort-orders))
(citeproc-sort-itds-on-citnum itds))))
(setq itds (citeproc-sort-itds itds sort-orders))))
;; Additionally sort according to subbibliographies if there are filters.
(when filters
(setq sorted (sort sorted #'citeproc-sort-itds-on-subbib)))
(when is-filtered
(setq itds (sort itds #'citeproc-sort-itds-on-subbib)))
;; Set the CSL citation-number field according to the sort order.
(--each-indexed sorted
(--each-indexed itds
(citeproc-itd-setvar it 'citation-number
(number-to-string (1+ it-index))))))))

View File

@@ -37,6 +37,7 @@
(cl-defstruct (citeproc-style (:constructor citeproc-style--create))
"A struct representing a parsed and localized CSL style.
CATEGORY is the style's category as a string,
INFO is the style's general info (currently simply the
corresponding fragment of the parsed xml),
OPTS, BIB-OPTS, CITE-OPTS and LOCALE-OPTS are alists of general
@@ -49,7 +50,6 @@ BIB-SORT-ORDERS and CITE-SORT-ORDERS are the lists of sort orders
the n-th key should be in ascending or desending order,
CITE-LAYOUT-ATTRS contains the attributes of the citation layout
as an alist,
CITE-NOTE is non-nil iff the style's citation-format is \"note\",
DATE-TEXT and DATE-NUMERIC are the style's date formats,
LOCALE contains the locale to be used or nil if not set,
MACROS is an alist with macro names as keys and corresponding
@@ -57,8 +57,8 @@ MACROS is an alist with macro names as keys and corresponding
TERMS is the style's parsed term-list,
USES-YS-VAR is non-nil iff the style uses the YEAR-SUFFIX
CSL-variable."
info opts bib-opts bib-sort bib-sort-orders
bib-layout cite-opts cite-note cite-sort cite-sort-orders
category info opts bib-opts bib-sort bib-sort-orders
bib-layout cite-opts cite-sort cite-sort-orders
cite-layout cite-layout-attrs locale-opts macros terms
uses-ys-var date-text date-numeric locale)
@@ -98,12 +98,13 @@ in-style locale information will be loaded (if available)."
(--each (cddr parsed-style)
(pcase (car it)
('info
(let ((info-lst (cddr it)))
(setf (citeproc-style-info style) info-lst
(citeproc-style-cite-note style)
(not (not (member '(category
((citation-format . "note")))
info-lst))))))
(let* ((info-lst (cddr it))
(category-info (cl-find-if
(lambda (x) (and (eq 'category (car x))
(eq 'citation-format (caaadr x))))
info-lst))
(category (cdaadr category-info)))
(setf (citeproc-style-category style) category)))
('locale
(let ((lang (alist-get 'lang (cadr it))))
(when (and (citeproc-locale--compatible-p lang locale)
@@ -310,7 +311,16 @@ position and before the (possibly empty) body."
(cons str (cdr result)))
result)))
;; Handle `author' citation mode by stopping if needed
(citeproc-lib-maybe-stop-rendering 'names context final)))))
(citeproc-context-maybe-stop-rendering 'names context final)))))
(defun citeproc-style-cite-note (style)
"Return whether csl STYLE is a note style."
(string= (citeproc-style-category style) "note"))
(defun citeproc-style-cite-superscript-p (style)
"Return whether csl STYLE has a superscript citaton layout."
(string= (alist-get 'vertical-align (citeproc-style-cite-layout-attrs style))
"sup"))
(defun citeproc-style-global-opts (style layout)
"Return the global opts in STYLE for LAYOUT.

View File

@@ -25,6 +25,8 @@
;;; Code:
(require 'subr-x)
(require 'compat)
(require 'dash)
(require 'citeproc-proc)
@@ -39,7 +41,8 @@ see the documentation of `citeproc-add-subbib-filters'."
(let* ((csl-type (alist-get 'type vv))
(type (or (alist-get 'blt-type vv) csl-type))
(keyword (alist-get 'keyword vv))
(keywords (and keyword (split-string keyword "[ ,;]" t))))
(keywords (and keyword (mapcar #'string-clean-whitespace
(split-string keyword "[,;]" t)))))
(--every-p
(pcase it
(`(type . ,key) (string= type key))
@@ -54,17 +57,32 @@ see the documentation of `citeproc-add-subbib-filters'."
(defun citeproc-sb-add-subbib-info (proc)
"Add subbibliography information to the items in PROC."
(let ((filters (citeproc-proc-bib-filters proc)))
(maphash
(lambda (_ itemdata)
(let* ((varvals (citeproc-itemdata-varvals itemdata))
(subbib-nos
(-non-nil
(--map-indexed
(when (citeproc-sb--match-p varvals it) it-index)
filters))))
(setf (citeproc-itemdata-subbib-nos itemdata) subbib-nos)))
(citeproc-proc-itemdata proc))))
(when (citeproc-proc-filtered-bib-p proc)
(let ((filters (citeproc-proc-bib-filters proc)))
(maphash
(lambda (_ itemdata)
(let* ((varvals (citeproc-itemdata-varvals itemdata))
(subbib-nos
(-non-nil
(--map-indexed
(when (citeproc-sb--match-p varvals it) it-index)
filters))))
(setf (citeproc-itemdata-subbib-nos itemdata) subbib-nos)))
(citeproc-proc-itemdata proc)))))
(defun citeproc-sb-prune-unrendered (proc)
"Remove all itemdata about unrendered items from PROC.
An item is unrendered if
- there are subbibfilters but none of them matches it, and
- it is not cited."
(when (citeproc-proc-filtered-bib-p proc)
(let ((itemdata (citeproc-proc-itemdata proc)))
(maphash
(lambda (id data)
(when (and (citeproc-itemdata-uncited data)
(null (citeproc-itemdata-subbib-nos data)))
(remhash id itemdata)))
itemdata))))
(provide 'citeproc-subbibs)

View File

@@ -1,13 +1,14 @@
;;; citeproc.el --- A CSL 1.0.2 Citation Processor -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2022 András Simonyi
;; Copyright (C) 2017-2024 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
;; Maintainer: András Simonyi <andras.simonyi@gmail.com>
;; URL: https://github.com/andras-simonyi/citeproc-el
;; Keywords: bib
;; Package-Requires: ((emacs "26") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4"))
;; Version: 0.9
;; Package-Requires: ((emacs "26") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4")(compat "28.1"))
;; Package-Version: 20250525.1011
;; Package-Revision: e3bf1f80bcd6
;; 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
@@ -87,10 +88,12 @@ CITATIONS is a list of `citeproc-citation' structures."
(new-ids (--remove (gethash it itemdata) uniq-ids)))
;; Add all new items in one pass
(citeproc-proc-put-items-by-id proc new-ids)
;; Add itemdata to the cite structs and add them to the cite queue.
;; Internalize the cites dealing with locator-extra if present, add itemdata to
;; the cite structs and add them to the cite queue.
(dolist (citation citations)
(setf (citeproc-citation-cites citation)
(--map (cons (cons 'itd (gethash (alist-get 'id it) itemdata)) it)
(--map (cons (cons 'itd (gethash (alist-get 'id it) itemdata))
(citeproc-cite--internalize-locator it))
(citeproc-citation-cites citation)))
(queue-append (citeproc-proc-citations proc) citation))
(setf (citeproc-proc-finalized proc) nil))))
@@ -196,8 +199,8 @@ formatting parameters keyed to the parameter names as symbols:
punct-in-quote)))
itemdata)
(let* ((raw-bib
(if (cdr filters)
;; There are several filters, we need to select and sort the subbibs.
(if (citeproc-proc-filtered-bib-p proc)
;; There are filters, we need to select and sort the subbibs.
(let* ((nr-of-filters (length filters))
(result (make-list nr-of-filters nil))
;; We store boolean to-be-sorted flags for each sub-bib
@@ -228,7 +231,7 @@ formatting parameters keyed to the parameter names as symbols:
result))
;; Generate the raw bibs.
(--map (mapcar #'citeproc-itemdata-rawbibitem it) result))
;; No filters, so raw-bib is a list containg a single raw bibliograhy.
;; No filters, so raw-bib is a list containing a single raw bibliograhy.
(list (mapcar #'citeproc-itemdata-rawbibitem
(citeproc-sort-itds-on-citnum (hash-table-values itemdata))))))
;; Perform author-substitution.
@@ -239,8 +242,12 @@ formatting parameters keyed to the parameter names as symbols:
raw-bib)
raw-bib))
;; Calculate formatting params.
(max-offset (if (alist-get 'second-field-align bib-opts)
(citeproc-rt-max-offset itemdata)
;; NOTE: This is the only place where we check whether there are
;; bibliography items in the processor, even though the empty case
;; could be handled way more efficiently.
(max-offset (if (and (alist-get 'second-field-align bib-opts)
(not (hash-table-empty-p itemdata)))
(citeproc-proc-max-offset itemdata)
0))
(format-params (cons (cons 'max-offset max-offset)
(citeproc-style-bib-opts-to-formatting-params bib-opts)))

View File

@@ -0,0 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cl-libify" "20181130.230"
"Update elisp code to use cl-lib instead of cl."
'((emacs "25"))
:url "https://github.com/purcell/cl-libify"
:commit "e205b96f944a4f312fd523804cbbaf00027a3c8b"
:revdesc "e205b96f944a"
:keywords '("lisp")
:authors '(("Steve Purcell" . "steve@sanityinc.com"))
:maintainers '(("Steve Purcell" . "steve@sanityinc.com")))

View File

@@ -4,11 +4,10 @@
;; Author: Steve Purcell <steve@sanityinc.com>
;; Keywords: lisp
;; Package-Commit: e205b96f944a4f312fd523804cbbaf00027a3c8b
;; Homepage: https://github.com/purcell/cl-libify
;; Package-Requires: ((emacs "25"))
;; Package-Version: 20181130.230
;; Package-X-Original-Version: 0
;; Package-Revision: e205b96f944a
;; 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

View File

@@ -0,0 +1,14 @@
(define-package "code-cells" "20231119.2138" "Lightweight notebooks with support for ipynb files"
'((emacs "27.1"))
:commit "44546ca256f3da29e3ac884e3d699c8455acbd6e" :authors
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
:maintainers
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
:maintainer
'("Augusto Stoffel" . "arstoffel@gmail.com")
:keywords
'("convenience" "outlines")
:url "https://github.com/astoff/code-cells.el")
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@@ -0,0 +1,442 @@
;;; code-cells.el --- Lightweight notebooks with support for ipynb files -*- lexical-binding: t; -*-
;; Copyright (C) 2022, 2023 Free Software Foundation, Inc.
;; Author: Augusto Stoffel <arstoffel@gmail.com>
;; Keywords: convenience, outlines
;; URL: https://github.com/astoff/code-cells.el
;; Package-Requires: ((emacs "27.1"))
;; Version: 0.4
;; 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/>.
;;; Commentary:
;; With this package, you can efficiently navigate, edit and execute
;; code split into cells according to certain magic comments. It also
;; allows you to open ipynb notebook files directly in Emacs. They
;; will be automatically converted to a script for editing, and
;; converted back to notebook format when saving. An external tool,
;; Jupytext by default, is required for this.
;;
;; A minor mode, `code-cells-mode', provides the following features:
;;
;; - Fontification of cell boundaries.
;;
;; - Keybindings for the cell navigation and evaluation commands,
;; under the `C-c %' prefix.
;;
;; - Outline mode integration: cell headers have outline level
;; determined by the number of percent signs or asterisks; within a
;; cell, outline headings are as determined by the major mode, but
;; they are demoted by an amount corresponding to the level of the
;; containing cell. This provides code folding and hierarchical
;; navigation, among other things, when `outline-minor-mode' is
;; active.
;;
;; This minor mode is automatically activated when opening an ipynb
;; file, but you can also activate it in any other buffer, either
;; manually or through a hook.
;;; Code:
(require 'outline)
(require 'pulse)
(eval-when-compile
(require 'cl-lib)
(require 'let-alist)
(require 'rx))
(defgroup code-cells nil
"Utilities for code split into cells."
:group 'convenience
:prefix "code-cells-")
;;; Cell navigation
(defcustom code-cells-boundary-regexp
(rx line-start
(+ (syntax comment-start))
(or (seq (* (syntax whitespace)) "%" (group-n 1 (+ "%")))
(group-n 1 (+ "*"))
(seq " In[" (* (any space digit)) "]:")))
"Regular expression specifying cell boundaries.
It should match at the beginning of a line. The length of the
first capture determines the outline level."
:type 'regexp
:safe #'stringp)
;;;###autoload
(defun code-cells-forward-cell (&optional arg)
"Move to the next cell boundary, or end of buffer.
With ARG, repeat this that many times. If ARG is negative, move
backward."
(interactive "p")
(let ((page-delimiter code-cells-boundary-regexp))
(when (and (< 0 arg) (looking-at page-delimiter))
(forward-char))
(forward-page arg)
(unless (eobp)
(move-beginning-of-line 1))))
;;;###autoload
(defun code-cells-backward-cell (&optional arg)
"Move to the previous cell boundary, or beginning of buffer.
With ARG, repeat this that many times. If ARG is negative, move
forward."
(interactive "p")
(code-cells-forward-cell (- (or arg 1))))
(defun code-cells--bounds (&optional count use-region no-header)
"Return the bounds of the current code cell, as a cons.
If COUNT is non-nil, return instead a region containing COUNT
cells and starting or ending with the current cell, depending on
the sign of COUNT.
If USE-REGION is non-nil and the region is active, return the
region bounds instead.
If NO-HEADER is non-nil, do not include the cell boundary line."
(if (and use-region (use-region-p))
(list (region-beginning) (region-end))
(setq count (or count 1))
(save-excursion
(let ((end (progn (code-cells-forward-cell (max count 1))
(point))))
(code-cells-backward-cell (abs count))
(when no-header (forward-line))
(list (point) end)))))
(defun code-cells--bounds-of-cell-relative-from (distance)
"Return the bounds of the cell DISTANCE cells away from the current one."
(save-excursion
(when (/= 0 distance)
;; Except when at the boundary, `(code-cells-forward-cell -1)' doesn't
;; move out of current cell
(unless (looking-at-p code-cells-boundary-regexp)
(code-cells-backward-cell))
(code-cells-forward-cell distance))
(code-cells--bounds)))
(defun code-cells-move-cell-down (arg)
"Move current code cell vertically ARG cells.
Move up when ARG is negative and move down otherwise."
(interactive "p")
(pcase-let ((`(,current-beg ,current-end) (code-cells--bounds))
(`(,next-beg ,next-end) (code-cells--bounds-of-cell-relative-from arg)))
(unless (save-excursion
(and (/= current-beg next-beg)
(goto-char current-beg)
(looking-at-p code-cells-boundary-regexp)
(goto-char next-beg)
(looking-at-p code-cells-boundary-regexp)))
(user-error "Can't move cell"))
(transpose-regions current-beg current-end next-beg next-end)))
;;;###autoload
(defun code-cells-move-cell-up (&optional arg)
"Move current code cell vertically up ARG cells."
(interactive "p")
(code-cells-move-cell-down (- arg)))
;;;###autoload
(defun code-cells-mark-cell (&optional arg)
"Put point at the beginning of this cell, mark at end.
If ARG is non-nil, mark that many cells."
(interactive "p")
(pcase-let ((`(,start ,end) (code-cells--bounds arg)))
(goto-char start)
(push-mark end nil t)))
;;;###autoload
(defun code-cells-comment-or-uncomment (&optional arg)
"Comment or uncomment the current code cell.
ARG, if provided, is the number of comment characters to add or
remove."
(interactive "P")
(pcase-let* ((`(,header ,end) (code-cells--bounds arg))
(start (save-excursion
(goto-char header)
(forward-line)
(point))))
(comment-or-uncomment-region start end)))
;;;###autoload
(defun code-cells-command (fun &rest options)
"Return an anonymous command calling FUN on the current cell.
FUN is a function that takes two character positions as argument.
Most interactive commands that act on a region are of this form
and can be used here.
If OPTIONS contains the keyword :use-region, the command will act
on the region instead of the current cell when appropriate.
If OPTIONS contains the keyword :pulse, provide visual feedback
via `pulse-momentary-highlight-region'."
(let ((use-region (car (memq :use-region options)))
(pulse (car (memq :pulse options))))
(lambda ()
(interactive)
(pcase-let ((`(,start ,end) (code-cells--bounds nil use-region)))
(when pulse (pulse-momentary-highlight-region start end))
(funcall fun start end)))))
;;;###autoload
(defun code-cells-speed-key (command)
"Return a speed key definition, suitable for passing to `define-key'.
The resulting keybinding will only have any effect when the point
is at the beginning of a cell heading, in which case it executes
COMMAND."
(list 'menu-item nil command
:filter (lambda (d)
(when (and (bolp)
(looking-at code-cells-boundary-regexp))
d))))
;;; Code evaluation
(defcustom code-cells-eval-region-commands
`((drepl--current . drepl-eval-region)
(jupyter-repl-interaction-mode . ,(apply-partially 'jupyter-eval-region nil))
(python-mode . python-shell-send-region)
(emacs-lisp-mode . eval-region)
(lisp-interaction-mode . eval-region))
"Alist of commands to evaluate a region.
The keys are major or minor modes and the values are functions
taking region bounds as argument."
:type '(alist :key-type symbol :value-type symbol))
;;;###autoload
(defun code-cells-eval (start end)
"Evaluate code according to current modes.
The first suitable function from `code-cells-eval-region-commands'
is used to do the job.
Interactively, evaluate the region, if active, otherwise the
current code cell. With a numeric prefix, evaluate that many
code cells.
Called from Lisp, evaluate region between START and END."
(interactive (code-cells--bounds (prefix-numeric-value current-prefix-arg)
'use-region
'no-header))
(funcall
(or (seq-some (pcase-lambda (`(,mode . ,fun))
(when (or (and (boundp mode) (symbol-value mode))
(derived-mode-p mode))
fun))
code-cells-eval-region-commands)
(user-error
"No entry for the current modes in `code-cells-eval-region-commands'"))
start end)
(pulse-momentary-highlight-region start end))
;;;###autoload
(defun code-cells-eval-above (arg)
"Evaluate this and all above cells.
ARG (interactively, the prefix argument) specifies how many
additional cells after point to include."
(interactive "p")
(code-cells-eval (point-min) (save-excursion
(code-cells-forward-cell arg)
(point))))
;;; Minor mode
(defvar-local code-cells--saved-vars nil
"A place to save variables before activating `code-cells-mode'.")
(defun code-cells--outline-level ()
"Compute the outline level, taking code cells into account.
To be used as the value of the variable `outline-level'.
At a cell boundary, returns the cell outline level, as determined by
`code-cells-boundary-regexp'. Otherwise, returns the sum of the
outline level as determined by the major mode and the current cell
level."
(let* ((at-boundary (looking-at-p code-cells-boundary-regexp))
(mm-level (if at-boundary
0
(funcall (car code-cells--saved-vars))))
(cell-level (if (or at-boundary
(save-excursion
(re-search-backward
code-cells-boundary-regexp nil t)))
(if (match-string 1)
(- (match-end 1) (match-beginning 1))
1)
0)))
(+ cell-level mm-level)))
(defface code-cells-header-line '((t :extend t :overline t :inherit font-lock-comment-face))
"Face used by `code-cells-mode' to highlight cell boundaries.")
(defun code-cells--font-lock-keywords ()
"Font lock keywords to highlight cell boundaries."
`((,(rx (regexp code-cells-boundary-regexp) (* any) "\n")
0 'code-cells-header-line append)))
;;;###autoload
(define-minor-mode code-cells-mode
"Minor mode for cell-oriented code."
:keymap (make-sparse-keymap)
(if code-cells-mode
(progn
(setq-local
code-cells--saved-vars (list outline-level
outline-regexp
outline-heading-end-regexp
paragraph-start)
outline-level 'code-cells--outline-level
outline-regexp (rx (or (regexp code-cells-boundary-regexp)
(regexp outline-regexp)))
outline-heading-end-regexp "\n"
paragraph-separate (rx (or (regexp paragraph-separate)
(regexp code-cells-boundary-regexp))))
(font-lock-add-keywords nil (code-cells--font-lock-keywords)))
(setq-local outline-level (pop code-cells--saved-vars)
outline-regexp (pop code-cells--saved-vars)
outline-heading-end-regexp (pop code-cells--saved-vars)
paragraph-separate (pop code-cells--saved-vars))
(font-lock-remove-keywords nil (code-cells--font-lock-keywords)))
(font-lock-flush))
;;;###autoload
(defun code-cells-mode-maybe ()
"Turn on `code-cells-mode' if the buffer appears to contain cells.
This function is useful when added to a major mode hook."
(when (save-excursion
(goto-char (point-min))
(re-search-forward code-cells-boundary-regexp 5000 t))
(code-cells-mode)))
(let ((map (make-sparse-keymap)))
(define-key code-cells-mode-map "\C-c%" map)
(define-key map ";" 'code-cells-comment-or-uncomment)
(define-key map "@" 'code-cells-mark-cell)
(define-key map "b" 'code-cells-backward-cell)
(define-key map "f" 'code-cells-forward-cell)
(define-key map "B" 'code-cells-move-cell-up)
(define-key map "F" 'code-cells-move-cell-down)
(define-key map "e" 'code-cells-eval))
;;; Jupyter notebook conversion
(defcustom code-cells-convert-ipynb-style
'(("jupytext" "--to" "ipynb")
("jupytext" "--to" "auto:percent")
code-cells--guess-mode
code-cells-convert-ipynb-hook)
"Determines how to convert ipynb files for editing.
The first two entries are lists of strings: the command name and
arguments used, respectively, to convert to and from ipynb
format.
The third entry is a function called with no arguments to
determine the major mode to be called. The default setting tries
to guess it from the notebook metadata.
The fourth entry, also optional, is a hook run after the new
major mode is activated."
:type '(list (repeat string) (repeat string) function symbol))
(defvar code-cells-convert-ipynb-hook '(code-cells-mode)
"Hook used in the default `code-cells-convert-ipynb-style'.")
(defun code-cells--call-process (buffer command)
"Pipe BUFFER through COMMAND, with output to the current buffer.
Returns the process exit code. COMMAND is a list of strings, the
program name followed by arguments."
(unless (executable-find (car command))
(error "Can't find %s" (car command)))
(let ((logfile (make-temp-file "emacs-code-cells-")))
(unwind-protect
(prog1
(apply #'call-process-region nil nil (car command) nil
(list buffer logfile) nil
(cdr command))
(with-temp-buffer
(insert-file-contents logfile)
(unless (zerop (buffer-size))
(lwarn 'code-cells :warning
"Notebook conversion command %s said:\n%s"
command
(buffer-substring-no-properties
(point-min) (point-max))))))
(delete-file logfile))))
(defun code-cells--guess-mode ()
"Guess major mode associated to the current ipynb buffer."
(require 'json)
(declare-function json-read "json.el")
(goto-char (point-min))
(let* ((nb (cl-letf ;; Skip over the possibly huge "cells" section
(((symbol-function 'json-read-array) 'forward-sexp))
(json-read)))
(lang (let-alist nb
(or .metadata.kernelspec.language
.metadata.jupytext.main_language)))
(mode (intern (concat lang "-mode"))))
(alist-get mode (bound-and-true-p major-mode-remap-alist) mode)))
;;;###autoload
(defun code-cells-convert-ipynb ()
"Convert buffer from ipynb format to a regular script."
(interactive)
(let* ((mode (funcall (or (nth 2 code-cells-convert-ipynb-style)
(progn ;For backwards compatibility with v0.3
(lwarn 'code-cells :warning "\
The third entry of `code-cells-convert-ipynb-style' should not be nil.")
#'code-cells--guess-mode))))
(exit (progn
(goto-char (point-min))
(code-cells--call-process t (nth 1 code-cells-convert-ipynb-style)))))
(unless (zerop exit)
(delete-region (point-min) (point))
(error "Error converting notebook (exit code %s)" exit))
(delete-region (point) (point-max))
(goto-char (point-min))
(set-buffer-modified-p nil)
(add-hook 'write-file-functions #'code-cells-write-ipynb 80 t)
(when (fboundp mode)
(funcall mode)
(run-hooks (nth 3 code-cells-convert-ipynb-style)))))
;;;###autoload
(defun code-cells-write-ipynb (&optional file)
"Convert buffer to ipynb format and write to FILE.
Interactively, asks for the file name. When called from Lisp,
FILE defaults to the current buffer file name."
(interactive "F")
(let* ((file (or file buffer-file-name))
(temp (generate-new-buffer " *cells--call-process output*"))
(exit (code-cells--call-process temp (nth 0 code-cells-convert-ipynb-style))))
(unless (eq 0 exit)
(error "Error converting notebook (exit code %s)" exit))
(with-current-buffer temp
(write-region nil nil file)
(kill-buffer))
(when (eq file buffer-file-name)
(set-buffer-modified-p nil)
(set-visited-file-modtime))
'job-done))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.ipynb\\'" . code-cells-convert-ipynb))
(provide 'code-cells)
;;; code-cells.el ends here

View File

@@ -0,0 +1,15 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-anaconda" "20230821.2126"
"Anaconda backend for company-mode."
'((emacs "25.1")
(company "0.8.0")
(anaconda-mode "0.1.1")
(cl-lib "0.5.0")
(dash "2.6.0")
(s "1.9"))
:url "https://github.com/proofit404/anaconda-mode"
:commit "14867265e474f7a919120bbac74870c3256cbacf"
:revdesc "14867265e474"
:keywords '("convenience" "company" "anaconda")
:authors '(("Artem Malyshev" . "proofit404@gmail.com"))
:maintainers '(("Artem Malyshev" . "proofit404@gmail.com")))

View File

@@ -4,10 +4,10 @@
;; Author: Artem Malyshev <proofit404@gmail.com>
;; URL: https://github.com/proofit404/anaconda-mode
;; Package-Version: 20200404.1859
;; Package-Commit: da1566db41a68809ef7f91ebf2de28118067c89b
;; Version: 0.2.0
;; Package-Requires: ((company "0.8.0") (anaconda-mode "0.1.1") (cl-lib "0.5.0") (dash "2.6.0") (s "1.9"))
;; Package-Version: 20230821.2126
;; Package-Revision: 14867265e474
;; Package-Requires: ((emacs "25.1") (company "0.8.0") (anaconda-mode "0.1.1") (cl-lib "0.5.0") (dash "2.6.0") (s "1.9"))
;; Keywords: convenience company anaconda
;; 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

View File

@@ -0,0 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-ledger" "20210910.250"
"Fuzzy auto-completion for Ledger & friends."
'((emacs "24.3")
(company "0.8.0"))
:url "https://github.com/debanjum/company-ledger"
:commit "55fdddd6c5e9c061c685b474ef5e148a4ac9b576"
:revdesc "55fdddd6c5e9"
:keywords '("abbrev" "matching" "auto-complete" "beancount" "ledger" "company")
:authors '(("Debanjum Singh Solanky" . "debanjumATgmailDOTcom"))
:maintainers '(("Debanjum Singh Solanky" . "debanjumATgmailDOTcom")))

View File

@@ -6,8 +6,7 @@
;; Description: Fuzzy auto-completion for ledger & friends
;; Keywords: abbrev, matching, auto-complete, beancount, ledger, company
;; Package-Version: 20210910.250
;; Package-Commit: 55fdddd6c5e9c061c685b474ef5e148a4ac9b576
;; Version: 0.1.0
;; Package-Revision: 55fdddd6c5e9
;; Package-Requires: ((emacs "24.3") (company "0.8.0"))
;; URL: https://github.com/debanjum/company-ledger

View File

@@ -0,0 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-quickhelp" "20231026.1714"
"Popup documentation for completion candidates."
'((emacs "24.3")
(company "0.8.9")
(pos-tip "0.4.6"))
:url "https://www.github.com/expez/company-quickhelp"
:commit "5bda859577582cc42d16fc0eaf5f7c8bedfd9e69"
:revdesc "5bda85957758"
:keywords '("company" "popup" "documentation" "quickhelp")
:authors '(("Lars Andersen" . "expez@expez.com"))
:maintainers '(("Lars Andersen" . "expez@expez.com")))

View File

@@ -4,10 +4,9 @@
;; Author: Lars Andersen <expez@expez.com>
;; URL: https://www.github.com/expez/company-quickhelp
;; Package-Version: 20221212.534
;; Package-Commit: 9505fb09d064581da142d75c139d48b5cf695bd5
;; Keywords: company popup documentation quickhelp
;; Version: 2.2.0
;; Package-Version: 20231026.1714
;; Package-Revision: 5bda85957758
;; Package-Requires: ((emacs "24.3") (company "0.8.9") (pos-tip "0.4.6"))
;; This file is not part of GNU Emacs.
@@ -55,7 +54,7 @@
"Delay, in seconds, before the quickhelp popup appears.
If set to nil the popup won't automatically appear, but can still
be triggered manually using `company-quickhelp-show'."
be triggered manually using `company-quickhelp-manual-begin'."
:type '(choice (number :tag "Delay in seconds")
(const :tag "Don't popup help automatically" nil))
:group 'company-quickhelp)
@@ -235,7 +234,6 @@ currently active `company' completion candidate."
(defun company-quickhelp-hide ()
(company-cancel))
(defun company-quickhelp-pos-tip-available-p ()
"Return t if and only if pos-tip is expected work in the current frame."
(and

View File

@@ -0,0 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-statistics" "20170210.1933"
"Sort candidates using completion history."
'((emacs "24.3")
(company "0.8.5"))
:url "https://github.com/company-mode/company-statistics"
:commit "e62157d43b2c874d2edbd547c3bdfb05d0a7ae5c"
:revdesc "e62157d43b2c"
:keywords '("abbrev" "convenience" "matching")
:authors '(("Ingo Lohmar" . "i.lohmar@gmail.com"))
:maintainers '(("Ingo Lohmar" . "i.lohmar@gmail.com")))

View File

@@ -0,0 +1,376 @@
;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding: t -*-
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
;; Author: Ingo Lohmar <i.lohmar@gmail.com>
;; URL: https://github.com/company-mode/company-statistics
;; Package-Version: 20170210.1933
;; Package-Revision: e62157d43b2c
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Package installed from elpa.gnu.org:
;;
;; (add-hook 'after-init-hook #'company-statistics-mode)
;;
;; Manually installed: make sure that this file is in load-path, and
;;
;; (require 'company-statistics)
;; (company-statistics-mode)
;;
;; Every time a candidate is chosen using company-mode, we keep track of this
;; (for a limited amount of recent choices). When presenting completion
;; candidates next time, they are sorted according to the score thus acquired.
;;
;; The same candidate might occur in different modes, projects, files etc., and
;; possibly has a different meaning each time. Therefore along with the
;; completion, we store some context information. In the default (heavy)
;; configuration, we track the overall frequency, the major-mode of the buffer,
;; the last preceding keyword, the parent symbol, and the filename (if it
;; applies), and the same criteria are used to score all possible candidates.
;;; Code:
(require 'company)
(defgroup company-statistics nil
"Completion candidates ranking by historical statistics."
:group 'company)
(defcustom company-statistics-size 400
"Number of completion choices that `company-statistics' keeps track of.
As this is a global cache, making it too small defeats the purpose."
:type 'integer
:initialize #'custom-initialize-default
:set #'company-statistics--log-resize)
(defcustom company-statistics-file
(concat user-emacs-directory "company-statistics-cache.el")
"File to save company-statistics state."
:type 'string)
(defcustom company-statistics-auto-save t
"Whether to save the statistics when leaving emacs."
:type 'boolean)
(defcustom company-statistics-auto-restore t
"Whether to restore statistics when company-statistics is enabled and has
not been used before."
:type 'boolean)
(defcustom company-statistics-capture-context #'company-statistics-capture-context-heavy
"Function called with single argument (t if completion started manually).
This is the place to store any context information for a completion run."
:type 'function)
(defcustom company-statistics-score-change #'company-statistics-score-change-heavy
"Function called with completion choice. Using arbitrary other info,
it should produce an alist, each entry labeling a context and the
associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)). Nil is
the global context."
:type 'function)
(defcustom company-statistics-score-calc #'company-statistics-score-calc-heavy
"Function called with completion candidate. Using arbitrary other info,
eg, on the current context, it should evaluate to the candidate's score (a
number)."
:type 'function)
;; internal vars, persistence
(defvar company-statistics--scores nil
"Store selection frequency of candidates in given contexts.")
(defvar company-statistics--log nil
"Ring keeping a log of statistics updates.")
(defvar company-statistics--index nil
"Index into the log.")
(defun company-statistics--init ()
"Initialize company-statistics."
(setq company-statistics--scores
(make-hash-table :test #'equal :size company-statistics-size))
(setq company-statistics--log (make-vector company-statistics-size nil)
company-statistics--index 0))
(defun company-statistics--initialized-p ()
(hash-table-p company-statistics--scores))
(defun company-statistics--log-resize (_option new-size)
(when (company-statistics--initialized-p)
;; hash scoresheet auto-resizes, but log does not
(let ((new-hist (make-vector new-size nil))
;; use actual length, to also work for freshly restored stats
(company-statistics-size (length company-statistics--log)))
;; copy newest entries (possibly nil) to new-hist
(dolist (i (number-sequence 0 (1- (min new-size company-statistics-size))))
(let ((old-i (mod (+ (- company-statistics--index new-size) i)
company-statistics-size)))
(aset new-hist i (aref company-statistics--log old-i))))
;; remove discarded log entry (when shrinking) from scores
(when (< new-size company-statistics-size)
(dolist (i (number-sequence
company-statistics--index
(+ company-statistics-size
company-statistics--index
(1- new-size))))
(company-statistics--log-revert (mod i company-statistics-size))))
(setq company-statistics--log new-hist)
(setq company-statistics--index (if (<= new-size company-statistics-size)
0
company-statistics-size))))
(setq company-statistics-size new-size))
(defun company-statistics--save ()
"Save statistics."
(with-temp-buffer
(set-buffer-multibyte nil)
(let (print-level print-length)
(encode-coding-string
(format
"%S"
`(setq
company-statistics--scores ,company-statistics--scores
company-statistics--log ,company-statistics--log
company-statistics--index ,company-statistics--index))
'utf-8 nil (current-buffer))
(let ((coding-system-for-write 'binary))
(write-region nil nil company-statistics-file)))))
(defun company-statistics--maybe-save ()
(when (and (company-statistics--initialized-p)
company-statistics-auto-save)
(company-statistics--save)))
(defun company-statistics--load ()
"Restore statistics."
(load company-statistics-file 'noerror nil 'nosuffix))
;; score calculation for insert/retrieval --- can be changed on-the-fly
(defun company-statistics-score-change-light (_cand)
"Count for global score and mode context."
(list (cons nil 1)
(cons major-mode 1))) ;major-mode is never nil
(defun company-statistics-score-calc-light (cand)
"Global score, and bonus for matching major mode."
(let ((scores (gethash cand company-statistics--scores)))
(if scores
;; cand may be in scores and still have no global score left
(+ (or (cdr (assoc nil scores)) 0)
(or (cdr (assoc major-mode scores)) 0))
0)))
(defvar company-statistics--context nil
"Current completion context, a list of entries searched using `assoc'.")
(defun company-statistics--last-keyword ()
"Return last keyword, ie, text of region fontified with the
font-lock-keyword-face up to point, or nil."
(let ((face-pos (point)))
(while (and (number-or-marker-p face-pos)
(< (point-min) face-pos)
(not (eq (get-text-property (1- face-pos) 'face)
'font-lock-keyword-face)))
(setq face-pos
(previous-single-property-change face-pos 'face nil (point-min))))
(when (and (number-or-marker-p face-pos)
(eq (get-text-property (max (point-min) (1- face-pos)) 'face)
'font-lock-keyword-face))
(list :keyword
(buffer-substring-no-properties
(previous-single-property-change face-pos 'face nil (point-min))
face-pos)))))
(defun company-statistics--parent-symbol ()
"Return symbol immediately preceding current completion prefix, or nil.
May be separated by punctuation, but not by whitespace."
;; expects to be at start of company-prefix; little sense for lisps
(let ((preceding (save-excursion
(unless (zerop (skip-syntax-backward "."))
(substring-no-properties (symbol-name (symbol-at-point)))))))
(when preceding
(list :symbol preceding))))
(defun company-statistics--file-name ()
"Return buffer file name, or nil."
(when buffer-file-name
(list :file buffer-file-name)))
(defun company-statistics-capture-context-heavy (_manual)
"Calculate some context, once for the whole completion run."
(save-excursion
(backward-char (length company-prefix))
(setq company-statistics--context
(delq nil
(list (company-statistics--last-keyword)
(company-statistics--parent-symbol)
(company-statistics--file-name))))))
(defun company-statistics-score-change-heavy (_cand)
"Count for global score, mode context, last keyword, parent symbol,
buffer file name."
(let ((last-kwd (assoc :keyword company-statistics--context))
(parent-symbol (assoc :symbol company-statistics--context))
(file (assoc :file company-statistics--context)))
(nconc ;when's nil is removed
(list (cons nil 1)
(cons major-mode 1)) ;major-mode is never nil
;; only add pieces of context if non-nil
(when last-kwd (list (cons last-kwd 1)))
(when parent-symbol (list (cons parent-symbol 1)))
(when file (list (cons file 1))))))
(defun company-statistics-score-calc-heavy (cand)
"Global score, and bonus for matching major mode, last keyword, parent
symbol, buffer file name."
(let ((scores (gethash cand company-statistics--scores))
(last-kwd (assoc :keyword company-statistics--context))
(parent-symbol (assoc :symbol company-statistics--context))
(file (assoc :file company-statistics--context)))
(if scores
;; cand may be in scores and still have no global score left
(+ (or (cdr (assoc nil scores)) 0)
(or (cdr (assoc major-mode scores)) 0)
;; some context may not apply, make sure to not get nil context
(or (cdr (when last-kwd (assoc last-kwd scores))) 0)
(or (cdr (when parent-symbol (assoc parent-symbol scores))) 0)
(or (cdr (when file (assoc file scores))) 0))
0)))
;; score manipulation in one place --- know about hash value alist structure
(defun company-statistics--alist-update (alist updates merger &optional filter)
"Return new alist with conses from ALIST. Their cdrs are updated
to (merger cdr update-cdr) if the UPDATES alist contains an entry with an
equal-matching car. If FILTER called with the result is non-nil, remove
the cons from the result. If no matching cons exists in ALIST, add the new
one. ALIST structure and cdrs may be changed!"
(let ((filter (or filter 'ignore))
(updated alist)
(new nil))
(mapc
(lambda (upd)
(let ((found (assoc (car upd) alist)))
(if found
(let ((result (funcall merger (cdr found) (cdr upd))))
(if (funcall filter result)
(setq updated (delete found updated))
(setcdr found result)))
(push upd new))))
updates)
(nconc updated new)))
(defun company-statistics--scores-add (cand score-updates)
(puthash cand
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
#'+)
company-statistics--scores))
(defun company-statistics--log-revert (&optional index)
"Revert score updates for log entry. INDEX defaults to
`company-statistics--index'."
(let ((hist-entry
(aref company-statistics--log
(or index company-statistics--index))))
(when hist-entry ;ignore nil entry
(let* ((cand (car hist-entry))
(score-updates (cdr hist-entry))
(new-scores
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
#'-
#'zerop)))
(if new-scores ;sth left
(puthash cand new-scores company-statistics--scores)
(remhash cand company-statistics--scores))))))
(defun company-statistics--log-store (result score-updates)
"Insert/overwrite result and associated score updates."
(aset company-statistics--log company-statistics--index
(cons result score-updates))
(setq company-statistics--index
(mod (1+ company-statistics--index) company-statistics-size)))
;; core functions: updater, actual sorting transformer, minor-mode
(defun company-statistics--start (manual)
(funcall company-statistics-capture-context manual))
(defun company-statistics--finished (result)
"After completion, update scores and log."
(let* ((score-updates (funcall company-statistics-score-change result))
(result (substring-no-properties result)))
(company-statistics--scores-add result score-updates)
(company-statistics--log-revert)
(company-statistics--log-store result score-updates)))
(defun company-sort-by-statistics (candidates)
"Sort candidates by historical statistics. Stable sort, so order is only
changed for candidates distinguishable by score."
(setq candidates
(sort candidates
(lambda (cand1 cand2)
(> (funcall company-statistics-score-calc cand1)
(funcall company-statistics-score-calc cand2))))))
;;;###autoload
(define-minor-mode company-statistics-mode
"Statistical sorting for company-mode. Ranks completion candidates by
the frequency with which they have been chosen in recent (as given by
`company-statistics-size') history.
Turning this mode on and off preserves the statistics. They are also
preserved automatically between Emacs sessions in the default
configuration. You can customize this behavior with
`company-statistics-auto-save', `company-statistics-auto-restore' and
`company-statistics-file'."
nil nil nil
:global t
(if company-statistics-mode
(progn
(unless (company-statistics--initialized-p)
(if (and company-statistics-auto-restore
(company-statistics--load))
;; maybe of different size
(company-statistics--log-resize nil company-statistics-size)
(company-statistics--init)))
(add-to-list 'company-transformers
'company-sort-by-statistics 'append)
(add-hook 'company-completion-started-hook
'company-statistics--start)
(add-hook 'company-completion-finished-hook
'company-statistics--finished))
(setq company-transformers
(delq 'company-sort-by-statistics company-transformers))
(remove-hook 'company-completion-started-hook
'company-statistics--start)
(remove-hook 'company-completion-finished-hook
'company-statistics--finished)))
(add-hook 'kill-emacs-hook 'company-statistics--maybe-save)
(provide 'company-statistics)
;;; company-statistics.el ends here

View File

@@ -1,15 +1,13 @@
(define-package "company-web" "20220115.2146" "Company version of ac-html, complete for web,html,emmet,jade,slim modes"
'((company "0.8.0")
(dash "2.8.0")
(cl-lib "0.5.0")
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-web" "20220115.2146"
"Company version of ac-html, complete for web,html,emmet,jade,slim modes."
'((company "0.8.0")
(dash "2.8.0")
(cl-lib "0.5.0")
(web-completion-data "0.1.0"))
:commit "e0c6bfa3ae7006c73d0fdfc0fdb69816309baf1b" :authors
'(("Olexandr Sydorchuk" . "olexandr.syd@gmail.com"))
:maintainer
'("Olexandr Sydorchuk" . "olexandr.syd@gmail.com")
:keywords
'("html" "company")
:url "https://github.com/osv/company-web")
;; Local Variables:
;; no-byte-compile: t
;; End:
:url "https://github.com/osv/company-web"
:commit "e0c6bfa3ae7006c73d0fdfc0fdb69816309baf1b"
:revdesc "e0c6bfa3ae70"
:keywords '("html" "company")
:authors '(("Olexandr Sydorchuk" . "olexandr.syd@gmail.com"))
:maintainers '(("Olexandr Sydorchuk" . "olexandr.syd@gmail.com")))

View File

@@ -3,7 +3,8 @@
;; Copyright (C) 2015 Olexandr Sydorchuk
;; Author: Olexandr Sydorchuk <olexandr.syd@gmail.com>
;; Version: 2.1
;; Package-Version: 20220115.2146
;; Package-Revision: e0c6bfa3ae70
;; Keywords: html, company
;; Package-Requires: ((company "0.8.0") (dash "2.8.0") (cl-lib "0.5.0") (web-completion-data "0.1.0"))
;; URL: https://github.com/osv/company-web

View File

@@ -1,6 +1,6 @@
;;; company-abbrev.el --- company-mode completion backend for abbrev
;;; company-abbrev.el --- company-mode completion backend for abbrev -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2015, 2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2015, 2021, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -29,21 +29,23 @@
(require 'cl-lib)
(require 'abbrev)
(defun company-abbrev-insert (match)
(defun company-abbrev-insert (_match)
"Replace MATCH with the expanded abbrev."
(expand-abbrev))
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
(defun company-abbrev (command &optional arg &rest _ignored)
"`company-mode' completion backend for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
'company-abbrev-insert))
(prefix (company-grab-symbol))
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
(candidates (apply
#'nconc
(mapcar (lambda (table)
(delete "" (all-completions arg table)))
(abbrev--active-tables))))
(kind 'snippet)
(meta (abbrev-expansion arg))
(post-completion (expand-abbrev))))

View File

@@ -1,6 +1,6 @@
;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode
;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode -*- lexical-binding: t -*-
;; Copyright (C) 2013-2016, 2020 Free Software Foundation, Inc.
;; Copyright (C) 2013-2016, 2020, 2023 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
@@ -23,9 +23,7 @@
(require 'cl-lib)
(declare-function bbdb-record-get-field "bbdb")
(declare-function bbdb-records "bbdb")
(declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
"Completion backend for BBDB."
@@ -40,10 +38,12 @@
(cl-mapcan (lambda (record)
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
(bbdb-record-get-field record 'mail)))
(eval '(bbdb-search (bbdb-records) arg nil arg))))
(eval `(let ((arg ,arg))
(bbdb-search (bbdb-records) :all-names arg :mail arg))
t)))
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
(defun company-bbdb (command &optional arg &rest _ignore)
"`company-mode' completion backend for BBDB."
(interactive (list 'interactive))
(cl-case command

View File

@@ -1,6 +1,6 @@
;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
@@ -19,7 +19,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The CAPF back-end provides a bridge to the standard
@@ -32,13 +31,27 @@
(require 'company)
(require 'cl-lib)
(defgroup company-capf nil
"Completion backend as adapter for `completion-at-point-functions'."
:group 'company)
(defcustom company-capf-disabled-functions '(tags-completion-at-point-function
ispell-completion-at-point)
"List of completion functions which should be ignored in this backend.
By default it contains the functions that duplicate the built-in backends
but don't support the corresponding configuration options and/or alter the
intended priority of the default backends' configuration."
:type 'hook
:package-version '(company . "1.0.0"))
;; Amortizes several calls to a c-a-p-f from the same position.
(defvar company--capf-cache nil)
;; FIXME: Provide a way to save this info once in Company itself
;; (https://github.com/company-mode/company-mode/pull/845).
(defvar-local company-capf--current-completion-data nil
"Value last returned by `company-capf' when called with `candidates'.
"Value last returned by `company-capf' in response to `candidates'.
For most properties/actions, this is just what we need: the exact values
that accompanied the completion table that's currently is use.
@@ -46,6 +59,9 @@ that accompanied the completion table that's currently is use.
a completion session (most importantly, by `company-sort-by-occurrence'),
so we can't just use the preceding variable instead.")
(defvar-local company-capf--current-completion-metadata nil
"Metadata computed with the current prefix and data above.")
(defun company--capf-data ()
(let ((cache company--capf-cache))
(if (and (equal (current-buffer) (car cache))
@@ -57,105 +73,60 @@ so we can't just use the preceding variable instead.")
(list (current-buffer) (point) (buffer-chars-modified-tick) data))
data))))
(defun company--contains (elt lst)
(when-let ((cur (car lst)))
(cond
((symbolp cur)
(or (eq elt cur)
(company--contains elt (cdr lst))))
((listp cur)
(or (company--contains elt cur)
(company--contains elt (cdr lst)))))))
(defun company--capf-data-real ()
(cl-letf* (((default-value 'completion-at-point-functions)
(if (company--contains 'company-etags company-backends)
;; Ignore tags-completion-at-point-function because it subverts
;; company-etags in the default value of company-backends, where
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions))
(default-value 'completion-at-point-functions)))
(completion-at-point-functions (company--capf-workaround))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'company--capf-wrapper 'optimist)))
(let ((data (run-hook-wrapped 'completion-at-point-functions
;; Ignore disabled and misbehaving functions.
#'company--capf-wrapper 'optimist)))
(when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
(defun company--capf-wrapper (fun which)
(let ((buffer-read-only t)
(inhibit-read-only nil)
(completion-in-region-function
(lambda (beg end coll pred)
(throw 'company--illegal-completion-in-region
(list fun beg end coll :predicate pred)))))
(catch 'company--illegal-completion-in-region
(condition-case nil
(completion--capf-wrapper fun which)
(buffer-read-only nil)))))
;; E.g. tags-completion-at-point-function subverts company-etags in the
;; default value of company-backends, where the latter comes later.
(unless (memq fun company-capf-disabled-functions)
(let ((buffer-read-only t)
(inhibit-read-only nil)
(completion-in-region-function
(lambda (beg end coll pred)
(throw 'company--illegal-completion-in-region
(list fun beg end coll :predicate pred)))))
(catch 'company--illegal-completion-in-region
(condition-case nil
(completion--capf-wrapper fun which)
(buffer-read-only nil))))))
(declare-function python-shell-get-process "python")
(defun company--capf-workaround ()
;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
(if (or (not (listp completion-at-point-functions))
(not (memq 'python-completion-complete-at-point completion-at-point-functions))
(python-shell-get-process))
completion-at-point-functions
(remq 'python-completion-complete-at-point completion-at-point-functions)))
(defun company-capf--save-current-data (data)
(setq company-capf--current-completion-data data)
(defun company-capf--save-current-data (data metadata)
(setq company-capf--current-completion-data data
company-capf--current-completion-metadata metadata)
(add-hook 'company-after-completion-hook
#'company-capf--clear-current-data nil t))
(defun company-capf--clear-current-data (_ignored)
(setq company-capf--current-completion-data nil))
(setq company-capf--current-completion-data nil
company-capf--current-completion-metadata nil))
(defvar-local company-capf--sorted nil)
(defvar-local company-capf--current-boundaries nil)
(defun company-capf (command &optional arg &rest _args)
(defun company-capf (command &optional arg &rest rest)
"`company-mode' backend using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
(let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
(prefix (buffer-substring-no-properties (nth 1 res) (point))))
(cond
((> (nth 2 res) (point)) 'stop)
(length (cons prefix length))
(t prefix))))))
(company-capf--prefix))
(`candidates
(company-capf--candidates arg))
(company-capf--candidates arg (car rest)))
(`sorted
company-capf--sorted)
(`match
;; Ask the for the `:company-match' function. If that doesn't help,
;; fallback to sniffing for face changes to get a suitable value.
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-match)))
(if f (funcall f arg)
(let* ((match-start nil) (pos -1)
(prop-value nil) (faces nil)
(has-face-p nil) chunks
(limit (length arg)))
(while (< pos limit)
(setq pos
(if (< pos 0) 0 (next-property-change pos arg limit)))
(setq prop-value (or
(get-text-property pos 'face arg)
(get-text-property pos 'font-lock-face arg))
faces (if (listp prop-value) prop-value (list prop-value))
has-face-p (memq 'completions-common-part faces))
(cond ((and (not match-start) has-face-p)
(setq match-start pos))
((and match-start (not has-face-p))
(push (cons match-start pos) chunks)
(setq match-start nil))))
(nreverse chunks)))))
(let ((f (or (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-match)
#'company--match-from-capf-face)))
(funcall f arg)))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
;non-prefix matches.
@@ -185,20 +156,35 @@ so we can't just use the preceding variable instead.")
(plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
(`init nil) ;Don't bother: plenty of other ways to initialize the code.
(`post-completion
(company--capf-post-completion arg))
(company-capf--post-completion arg))
(`adjust-boundaries
(company--capf-boundaries
company-capf--current-boundaries))
(`expand-common
(company-capf--expand-common arg (car rest)))
))
(defun company-capf--prefix ()
(let ((res (company--capf-data)))
(when res
(let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
(prefix (buffer-substring-no-properties (nth 1 res) (point)))
(suffix (buffer-substring-no-properties (point) (nth 2 res))))
(list prefix suffix length)))))
(defun company-capf--expand-common (prefix suffix)
(let* ((data company-capf--current-completion-data)
(table (nth 3 data))
(pred (plist-get (nthcdr 4 data) :predicate)))
(company--capf-expand-common prefix suffix table pred
company-capf--current-completion-metadata)))
(defun company-capf--annotation (arg)
(let* ((f (or (plist-get (nthcdr 4 company-capf--current-completion-data)
:annotation-function)
;; FIXME: Add a test.
(cdr (assq 'annotation-function
(completion-metadata
(buffer-substring (nth 1 company-capf--current-completion-data)
(nth 2 company-capf--current-completion-data))
(nth 3 company-capf--current-completion-data)
(plist-get (nthcdr 4 company-capf--current-completion-data)
:predicate))))))
company-capf--current-completion-metadata))))
(annotation (when f (funcall f arg))))
(if (and company-format-margin-function
(equal annotation " <f>") ; elisp-completion-at-point, pre-icons
@@ -207,49 +193,64 @@ so we can't just use the preceding variable instead.")
nil
annotation)))
(defun company-capf--candidates (input)
(let ((res (company--capf-data)))
(company-capf--save-current-data res)
(when res
(let* ((table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate))
(meta (completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
table pred))
(candidates (completion-all-completions input table pred
(length input)
meta))
(defun company-capf--candidates (input suffix)
(let* ((current-capf (car company-capf--current-completion-data))
(res (company--capf-data))
(table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate))
(meta (and res
(completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
table pred))))
(when (and res
(or (not current-capf)
(equal current-capf (car res))))
(let* ((interrupt (plist-get (nthcdr 4 res) :company-use-while-no-input))
(all-result (company-capf--candidates-1 input suffix
table pred
meta
(and non-essential
(eq interrupt t))))
(sortfun (cdr (assq 'display-sort-function meta)))
(last (last candidates))
(base-size (and (numberp (cdr last)) (cdr last))))
(when base-size
(setcdr last nil))
(candidates (assoc-default :completions all-result)))
(setq company-capf--sorted (functionp sortfun))
(when candidates
(company-capf--save-current-data res meta)
(setq company-capf--current-boundaries
(company--capf-boundaries-markers
(assoc-default :boundaries all-result)
company-capf--current-boundaries)))
(when sortfun
(setq candidates (funcall sortfun candidates)))
(if (not (zerop (or base-size 0)))
(let ((before (substring input 0 base-size)))
(mapcar (lambda (candidate)
(concat before candidate))
candidates))
candidates)))))
candidates))))
(defun company--capf-post-completion (arg)
(defun company-capf--candidates-1 (prefix suffix table pred meta interrupt-on-input)
(if (not interrupt-on-input)
(company--capf-completions prefix suffix table pred meta)
(let (res)
(and (while-no-input
(setq res
(company--capf-completions prefix suffix table pred meta))
nil)
(throw 'interrupted 'new-input))
res)))
(defun company-capf--post-completion (arg)
(let* ((res company-capf--current-completion-data)
(exit-function (plist-get (nthcdr 4 res) :exit-function))
(table (nth 3 res)))
(table (nth 3 res))
(prefix (nth 0 (company-capf--prefix))))
(if exit-function
;; We can more or less know when the user is done with completion,
;; so we do something different than `completion--done'.
;; Follow the example of `completion--done'.
(funcall exit-function arg
;; FIXME: Should probably use an additional heuristic:
;; completion-at-point doesn't know when the user picked a
;; particular candidate explicitly (it only checks whether
;; further completions exist). Whereas company user can press
;; RET (or use implicit completion with company-tng).
(if (= (car (completion-boundaries arg table nil ""))
(length arg))
'sole
(if (= (car (completion-boundaries prefix table nil ""))
(length prefix))
'exact
'finished)))))
(provide 'company-capf)

View File

@@ -1,6 +1,6 @@
;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -119,10 +119,9 @@ or automatically through a custom `company-clang-prefix-guesser'."
;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: Handle Pattern (syntactic hints would be neat).
;; Do we ever see OVERLOAD (or OVERRIDE)?
(defconst company-clang--completion-pattern
"^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?:\\(?: (InBase)\\)? : \\(.*\\)$\\)?$")
"^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\|Pattern\\)\\(?:\\(?: (InBase)\\)? : \\(.*\\)$\\)?$")
(defconst company-clang--error-buffer-name "*clang-error*")
@@ -138,14 +137,14 @@ or automatically through a custom `company-clang-prefix-guesser'."
(regexp-quote prefix)))
(case-fold-search nil)
(results (make-hash-table :test 'equal :size (/ (point-max) 100)))
lines match)
lines)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(unless (equal match "Pattern")
(save-match-data
(let ((match (match-string-no-properties 1))
(meta (match-string-no-properties 2)))
(when (equal match "Pattern")
(setq match (company-clang--pattern-to-match meta)))
(when (string-match ":" match)
(setq match (substring match 0 (match-beginning 0)))))
(let ((meta (match-string-no-properties 2)))
(setq match (substring match 0 (match-beginning 0))))
;; Avoiding duplicates:
;; https://github.com/company-mode/company-mode/issues/841
(cond
@@ -154,7 +153,7 @@ or automatically through a custom `company-clang-prefix-guesser'."
(puthash match meta results))
;; Or it's the first time we see this completion
((eq (gethash match results 'none) 'none)
(puthash match nil results))))))
(puthash match nil results)))))
(maphash
(lambda (match meta)
(when meta
@@ -163,6 +162,15 @@ or automatically through a custom `company-clang-prefix-guesser'."
results)
lines))
(defun company-clang--pattern-to-match (pat)
(let ((start 0)
(end nil))
(when (string-match "#]" pat)
(setq start (match-end 0)))
(when (string-match "[ \(]<#" pat start)
(setq end (match-beginning 0)))
(substring pat start end)))
(defun company-clang--meta (candidate)
(get-text-property 0 'meta candidate))
@@ -178,6 +186,8 @@ or automatically through a custom `company-clang-prefix-guesser'."
(delete-region pt (point)))
(buffer-string)))))
;; TODO: Parse the original formatting here, rather than guess.
;; Strip it every time in the `meta' handler instead.
(defun company-clang--annotation-1 (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
@@ -325,8 +335,8 @@ or automatically through a custom `company-clang-prefix-guesser'."
(defun company-clang--prefix ()
(if company-clang-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
(company-grab-symbol-parts "\\.\\|->\\|::" 2)
(company-grab-symbol-parts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@@ -1,9 +1,8 @@
;;; company-cmake.el --- company-mode completion backend for CMake
;;; company-cmake.el --- company-mode completion backend for CMake -*- lexical-binding: t -*-
;; Copyright (C) 2013-2015, 2017-2018, 2020 Free Software Foundation, Inc.
;; Copyright (C) 2013-2015, 2017-2018, 2020, 2023 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.2
;; 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
@@ -49,7 +48,7 @@ They affect which types of symbols we get completion candidates for.")
"^\\(%s[a-zA-Z0-9_<>]%s\\)$"
"Regexp to match the candidates.")
(defvar company-cmake-modes '(cmake-mode)
(defvar company-cmake-modes '(cmake-mode cmake-ts-mode)
"Major modes in which cmake may complete.")
(defvar company-cmake--candidates-cache nil
@@ -94,12 +93,10 @@ They affect which types of symbols we get completion candidates for.")
))
(defun company-cmake--parse (prefix content cmd)
(let ((start 0)
(pattern (format company-cmake--completion-pattern
(let ((pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(lines (split-string content "\n"))
match
rlt)
(dolist (line lines)
(when (string-match pattern line)
@@ -185,7 +182,7 @@ They affect which types of symbols we get completion candidates for.")
(and (eq (char-before (point)) ?\{)
(eq (char-before (1- (point))) ?$))))
(defun company-cmake (command &optional arg &rest ignored)
(defun company-cmake (command &optional arg &rest _ignored)
"`company-mode' completion backend for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))

View File

@@ -1,6 +1,6 @@
;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2016, 2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2016, 2021-2024 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -48,13 +48,16 @@ complete only symbols, not text in comments or strings. In other modes
(defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers.
If `all', search all other buffers, except the ignored ones. If t, search
buffers with the same major mode. If `code', search all buffers with major
modes in `company-dabbrev-code-modes', or derived from one of them. See
also `company-dabbrev-code-time-limit'."
buffers with the same major mode. If `code', search all
buffers with major modes in `company-dabbrev-code-modes', or derived from one of
them. This can also be a function that takes the current buffer as
parameter and returns a list of major modes to search. See also
`company-dabbrev-code-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "Code major modes" code)
(const :tag "All" all)))
(const :tag "All" all)
(function :tag "Function to return similar major-modes" group)))
(defcustom company-dabbrev-code-time-limit .1
"Determines how long `company-dabbrev-code' should look for matches."
@@ -69,14 +72,38 @@ also `company-dabbrev-code-time-limit'."
"Non-nil to ignore case when collecting completion candidates."
:type 'boolean)
(defcustom company-dabbrev-code-completion-styles nil
"Non-nil to use the completion styles for fuzzy matching."
:type '(choice (const :tag "Prefix matching only" nil)
(const :tag "Matching according to `completion-styles'" t)
(list :tag "Custom list of styles" symbol))
:package-version '(company . "1.0.0"))
(defvar-local company-dabbrev--boundaries nil)
(defvar-local company-dabbrev-code--sorted nil)
(defun company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
"\\(\\sw\\|\\s_\\)*\\_>"))
(let ((prefix-re
(cond
((string-empty-p prefix)
"\\([a-zA-Z]\\|\\s_\\)")
((not company-dabbrev-code-completion-styles)
(regexp-quote prefix))
(t
;; Use the cache at least after 2 chars. We could also cache
;; earlier, for users who set company-min-p-l to 1 or 0.
(let ((prefix (if (>= (length prefix) 2)
(substring prefix 0 2)
prefix)))
(concat
"\\(\\sw\\|\\s_\\)*"
(mapconcat #'regexp-quote
(mapcar #'string prefix)
"\\(\\sw\\|\\s_\\)*")))))))
(concat "\\_<" prefix-re "\\(\\sw\\|\\s_\\)*\\_>")))
;;;###autoload
(defun company-dabbrev-code (command &optional arg &rest _ignored)
(defun company-dabbrev-code (command &optional arg &rest rest)
"dabbrev-like `company-mode' backend for code.
The backend looks for all symbols in the current buffer that aren't in
comments or strings."
@@ -84,22 +111,77 @@ comments or strings."
(cl-case command
(interactive (company-begin-backend 'company-dabbrev-code))
(prefix (and (or (eq t company-dabbrev-code-modes)
(apply #'derived-mode-p company-dabbrev-code-modes))
(cl-some #'derived-mode-p company-dabbrev-code-modes))
(or company-dabbrev-code-everywhere
(not (company-in-string-or-comment)))
(or (company-grab-symbol) 'stop)))
(candidates (let ((case-fold-search company-dabbrev-code-ignore-case))
(company-dabbrev--search
(company-dabbrev-code--make-regexp arg)
company-dabbrev-code-time-limit
(pcase company-dabbrev-code-other-buffers
(`t (list major-mode))
(`code company-dabbrev-code-modes)
(`all `all))
(not company-dabbrev-code-everywhere))))
(company-grab-symbol-parts)))
(candidates (company-dabbrev--candidates arg (car rest)))
(adjust-boundaries (and company-dabbrev-code-completion-styles
(company--capf-boundaries
company-dabbrev--boundaries)))
(expand-common (company-dabbrev-code--expand-common arg (car rest)))
(kind 'text)
(sorted company-dabbrev-code--sorted)
(no-cache t)
(ignore-case company-dabbrev-code-ignore-case)
(match (when company-dabbrev-code-completion-styles
(company--match-from-capf-face arg)))
(duplicates t)))
(defun company-dabbrev-code--expand-common (prefix suffix)
(when company-dabbrev-code-completion-styles
(let ((completion-styles (if (listp company-dabbrev-code-completion-styles)
company-dabbrev-code-completion-styles
completion-styles)))
(company--capf-expand-common prefix suffix
(company-dabbrev-code--table prefix)))))
(defun company-dabbrev--candidates (prefix suffix)
(let* ((case-fold-search company-dabbrev-code-ignore-case))
(company-dabbrev-code--filter
prefix suffix
(company-dabbrev-code--table prefix))))
(defun company-dabbrev-code--table (prefix)
(let ((regexp (company-dabbrev-code--make-regexp prefix)))
(company-cache-fetch
'dabbrev-code-candidates
(lambda ()
(company-dabbrev--search
regexp
company-dabbrev-code-time-limit
(pcase company-dabbrev-code-other-buffers
(`t (list major-mode))
(`code company-dabbrev-code-modes)
((pred functionp) (funcall company-dabbrev-code-other-buffers (current-buffer)))
(`all `all))
(not company-dabbrev-code-everywhere)))
:expire t
:check-tag
(cons regexp company-dabbrev-code-completion-styles))))
(defun company-dabbrev-code--filter (prefix suffix table)
(let ((completion-ignore-case company-dabbrev-code-ignore-case)
(completion-styles (if (listp company-dabbrev-code-completion-styles)
company-dabbrev-code-completion-styles
completion-styles))
(metadata (completion-metadata prefix table nil))
res)
(if (not company-dabbrev-code-completion-styles)
(all-completions prefix table)
(setq res (company--capf-completions
prefix suffix
table nil
metadata))
(when-let* ((sort-fn (completion-metadata-get metadata 'display-sort-function)))
(setq company-dabbrev-code--sorted t)
(setf (alist-get :completions res)
(funcall sort-fn (alist-get :completions res))))
(setq company-dabbrev--boundaries
(company--capf-boundaries-markers
(assoc-default :boundaries res)
company-dabbrev--boundaries))
(assoc-default :completions res))))
(provide 'company-dabbrev-code)
;;; company-dabbrev-code.el ends here

View File

@@ -1,6 +1,6 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2018, 2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2018, 2021-2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -35,10 +35,13 @@
(defcustom company-dabbrev-other-buffers 'all
"Determines whether `company-dabbrev' should search other buffers.
If `all', search all other buffers, except the ignored ones. If t, search
buffers with the same major mode. See also `company-dabbrev-time-limit'."
buffers with the same major mode. This can also be a function that takes
the current buffer as parameter and returns a list of major modes to
search. See also `company-dabbrev-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "All" all)))
(const :tag "All" all)
(function :tag "Function to return similar major-modes" group)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
"Regexp matching the names of buffers to ignore.
@@ -70,10 +73,7 @@ candidate is inserted, even some of its characters have different case."
The value of nil means keep them as-is.
`case-replace' means use the value of `case-replace'.
Any other value means downcase.
If you set this value to nil, you may also want to set
`company-dabbrev-ignore-case' to any value other than `keep-prefix'."
Any other value means downcase."
:type '(choice
(const :tag "Keep as-is" nil)
(const :tag "Downcase" t)
@@ -114,7 +114,7 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(when (and (>= (length match) company-dabbrev-minimum-length)
(not (and company-dabbrev-ignore-invisible
(invisible-p (match-beginning 0)))))
(push match symbols)))))
(puthash match t symbols)))))
(goto-char (if pos (1- pos) (point-min)))
;; Search before pos.
(let ((tmp-end (point)))
@@ -147,7 +147,9 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
ignore-comments)
(let* ((start (current-time))
(symbols (company-dabbrev--search-buffer regexp (point) nil start limit
(symbols (company-dabbrev--search-buffer regexp (point)
(make-hash-table :test 'equal)
start limit
ignore-comments)))
(when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
@@ -157,7 +159,7 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(funcall company-dabbrev-ignore-buffers buffer))
(with-current-buffer buffer
(when (or (eq other-buffer-modes 'all)
(apply #'derived-mode-p other-buffer-modes))
(cl-some #'derived-mode-p other-buffer-modes))
(setq symbols
(company-dabbrev--search-buffer regexp nil symbols start
limit ignore-comments)))))
@@ -167,16 +169,38 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
symbols))
(defun company-dabbrev--prefix ()
;; Not in the middle of a word.
(unless (looking-at company-dabbrev-char-regexp)
;; Emacs can't do greedy backward-search.
(company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
company-dabbrev-char-regexp)
1)))
;; Emacs can't do greedy backward-search.
(list
(company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
company-dabbrev-char-regexp)
1)
(and (looking-at (format "\\(?:%s\\)*" company-dabbrev-char-regexp))
(match-string 0))))
(defun company-dabbrev--filter (prefix candidates)
(let ((completion-ignore-case company-dabbrev-ignore-case))
(all-completions prefix candidates)))
(let* ((completion-ignore-case company-dabbrev-ignore-case)
(filtered (all-completions prefix candidates))
(lp (length prefix))
(downcase (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
(when downcase
(let ((ptr filtered))
(while ptr
(setcar ptr (downcase (car ptr)))
(setq ptr (cdr ptr)))))
(if (and (eq company-dabbrev-ignore-case 'keep-prefix)
(not (= lp 0)))
(company-substitute-prefix prefix filtered)
filtered)))
(defun company-dabbrev--fetch ()
(company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
((pred functionp) (funcall company-dabbrev-other-buffers (current-buffer)))
(`all `all))))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest _ignored)
@@ -186,21 +210,14 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-dabbrev--prefix))
(candidates
(let* ((case-fold-search company-dabbrev-ignore-case)
(words (company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
(`all `all))))
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
(setq words (company-dabbrev--filter arg words))
(if downcase-p
(mapcar 'downcase words)
words)))
(company-dabbrev--filter
arg
;; FIXME: Only cache the result of non-interrupted scans?
(company-cache-fetch 'dabbrev-candidates #'company-dabbrev--fetch
:expire t)))
(kind 'text)
(ignore-case company-dabbrev-ignore-case)
(no-cache t)
(ignore-case (and company-dabbrev-ignore-case t))
(duplicates t)))
(provide 'company-dabbrev)

View File

@@ -1,226 +0,0 @@
;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2009-2015, 2017, 2020 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; In newer versions of Emacs, company-capf is used instead.
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'help-mode)
(require 'find-func)
(defgroup company-elisp nil
"Completion backend for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
"If enabled, offer Lisp functions only in appropriate contexts.
Functions are offered for completion only after \\=' and \(."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defcustom company-elisp-show-locals-first t
"If enabled, locally bound variables and functions are displayed
first in the candidates list."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defun company-elisp--prefix ()
(let ((prefix (company-grab-symbol)))
(if prefix
(when (if (company-in-string-or-comment)
(= (char-before (- (point) (length prefix))) ?`)
(company-elisp--should-complete))
prefix)
'stop)))
(defun company-elisp--predicate (symbol)
(or (boundp symbol)
(fboundp symbol)
(facep symbol)
(featurep symbol)))
(defun company-elisp--fns-regexp (&rest names)
(concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
(defvar company-elisp-parse-limit 30)
(defvar company-elisp-parse-depth 100)
(defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
(defvar company-elisp-var-binding-regexp
(apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
company-elisp-defun-names)
"Regular expression matching head of a multiple variable bindings form.")
(defvar company-elisp-var-binding-regexp-1
(company-elisp--fns-regexp "dolist" "dotimes")
"Regular expression matching head of a form with one variable binding.")
(defvar company-elisp-fun-binding-regexp
(company-elisp--fns-regexp "flet" "labels")
"Regular expression matching head of a function bindings form.")
(defvar company-elisp-defuns-regexp
(concat "([ \t\n]*"
(apply #'company-elisp--fns-regexp company-elisp-defun-names)))
(defun company-elisp--should-complete ()
(let ((start (point))
(depth (car (syntax-ppss))))
(not
(when (> depth 0)
(save-excursion
(up-list (- depth))
(when (looking-at company-elisp-defuns-regexp)
(forward-char)
(forward-sexp 1)
(unless (= (point) start)
(condition-case nil
(let ((args-end (scan-sexps (point) 2)))
(or (null args-end)
(> args-end start)))
(scan-error
t)))))))))
(defun company-elisp--locals (prefix functions-p)
(let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
"\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
(pos (point))
res)
(condition-case nil
(save-excursion
(dotimes (_ company-elisp-parse-depth)
(up-list -1)
(save-excursion
(when (eq (char-after) ?\()
(forward-char 1)
(when (ignore-errors
(save-excursion (forward-list)
(<= (point) pos)))
(skip-chars-forward " \t\n")
(cond
((looking-at (if functions-p
company-elisp-fun-binding-regexp
company-elisp-var-binding-regexp))
(down-list 1)
(condition-case nil
(dotimes (_ company-elisp-parse-limit)
(save-excursion
(when (looking-at "[ \t\n]*(")
(down-list 1))
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))
(forward-sexp))
(scan-error nil)))
((unless functions-p
(looking-at company-elisp-var-binding-regexp-1))
(down-list 1)
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))))))))
(scan-error nil))
res))
(defun company-elisp-candidates (prefix)
(let* ((predicate (company-elisp--candidates-predicate prefix))
(locals (company-elisp--locals prefix (eq predicate 'fboundp)))
(globals (company-elisp--globals prefix predicate))
(locals (cl-loop for local in locals
when (not (member local globals))
collect local)))
(if company-elisp-show-locals-first
(append (sort locals 'string<)
(sort globals 'string<))
(append locals globals))))
(defun company-elisp--globals (prefix predicate)
(all-completions prefix obarray predicate))
(defun company-elisp--candidates-predicate (prefix)
(let* ((completion-ignore-case nil)
(beg (- (point) (length prefix)))
(before (char-before beg)))
(if (and company-elisp-detect-function-context
(not (memq before '(?' ?`))))
(if (and (eq before ?\()
(not
(save-excursion
(ignore-errors
(goto-char (1- beg))
(or (company-elisp--before-binding-varlist-p)
(progn
(up-list -1)
(company-elisp--before-binding-varlist-p)))))))
'fboundp
'boundp)
'company-elisp--predicate)))
(defun company-elisp--before-binding-varlist-p ()
(save-excursion
(and (prog1 (search-backward "(")
(forward-char 1))
(looking-at company-elisp-var-binding-regexp))))
(defun company-elisp--doc (symbol)
(let* ((symbol (intern symbol))
(doc (if (fboundp symbol)
(documentation symbol t)
(documentation-property symbol 'variable-documentation t))))
(and (stringp doc)
(string-match ".*$" doc)
(match-string 0 doc))))
;;;###autoload
(defun company-elisp (command &optional arg &rest _ignored)
"`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))
(prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
(company-elisp--prefix)))
(candidates (company-elisp-candidates arg))
(sorted company-elisp-show-locals-first)
(meta (company-elisp--doc arg))
(doc-buffer (let ((symbol (intern arg)))
(save-window-excursion
(ignore-errors
(cond
((fboundp symbol) (describe-function symbol))
((boundp symbol) (describe-variable symbol))
((featurep symbol) (describe-package symbol))
((facep symbol) (describe-face symbol))
(t (signal 'user-error nil)))
(help-buffer)))))
(location (let ((sym (intern arg)))
(cond
((fboundp sym) (find-definition-noselect sym nil))
((boundp sym) (find-definition-noselect sym 'defvar))
((featurep sym) (cons (find-file-noselect (find-library-name
(symbol-name sym)))
0))
((facep sym) (find-definition-noselect sym 'defface)))))))
(provide 'company-elisp)
;;; company-elisp.el ends here

View File

@@ -1,6 +1,6 @@
;;; company-etags.el --- company-mode completion backend for etags
;;; company-etags.el --- company-mode completion backend for etags -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2015, 2018-2019 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2015, 2018-2019, 2023-2024 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -54,10 +54,18 @@ Set it to t or to a list of major modes."
(symbol :tag "Major mode")))
:package-version '(company . "0.9.0"))
(defcustom company-etags-completion-styles nil
"Non-nil to use the completion styles for fuzzy matching."
:type '(choice (const :tag "Prefix matching only" nil)
(const :tag "Matching according to `completion-styles'" t)
(list :tag "Custom list of styles" symbol))
:package-version '(company . "1.0.0"))
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
jde-mode pascal-mode perl-mode python-mode))
(defvar-local company-etags-buffer-table 'unknown)
(defvar-local company-etags--boundaries nil)
(defun company-etags-find-table ()
(let ((file (expand-file-name
@@ -74,34 +82,64 @@ Set it to t or to a list of major modes."
(setq company-etags-buffer-table (company-etags-find-table))
company-etags-buffer-table)))
(defun company-etags--candidates (prefix)
(defun company-etags--candidates (prefix suffix)
(let ((completion-ignore-case company-etags-ignore-case)
(completion-styles (if (listp company-etags-completion-styles)
company-etags-completion-styles
completion-styles))
(table (company-etags--table)))
(and table
(if company-etags-completion-styles
(let ((res (company--capf-completions prefix suffix table)))
(setq company-etags--boundaries
(company--capf-boundaries-markers
(assoc-default :boundaries res)
company-etags--boundaries))
(assoc-default :completions res))
(all-completions prefix table)))))
(defun company-etags--table ()
(let ((tags-table-list (company-etags-buffer-table))
(tags-file-name tags-file-name)
(completion-ignore-case company-etags-ignore-case))
(tags-file-name tags-file-name))
(and (or tags-file-name tags-table-list)
(fboundp 'tags-completion-table)
(save-excursion
(visit-tags-table-buffer)
(all-completions prefix (tags-completion-table))))))
(tags-completion-table)))))
(defun company-etags--expand-common (prefix suffix)
(when company-etags-completion-styles
(let ((completion-styles (if (listp company-etags-completion-styles)
company-etags-completion-styles
completion-styles)))
(company--capf-expand-common prefix suffix
(company-etags--table)))))
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
(defun company-etags (command &optional arg &rest rest)
"`company-mode' completion backend for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
(prefix (and (apply #'derived-mode-p company-etags-modes)
(prefix (and (cl-some #'derived-mode-p company-etags-modes)
(or (eq t company-etags-everywhere)
(apply #'derived-mode-p company-etags-everywhere)
(cl-some #'derived-mode-p company-etags-everywhere)
(not (company-in-string-or-comment)))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))
(company-grab-symbol-parts)))
(candidates (company-etags--candidates arg (car rest)))
(adjust-boundaries (and company-etags-completion-styles
(company--capf-boundaries
company-etags--boundaries)))
(expand-common (company-etags--expand-common arg (car rest)))
(no-cache company-etags-completion-styles)
(location (let ((tags-table-list (company-etags-buffer-table)))
(when (fboundp 'find-tag-noselect)
(save-excursion
(let ((buffer (find-tag-noselect arg)))
(cons buffer (with-current-buffer buffer (point))))))))
(match (when company-etags-completion-styles
(company--match-from-capf-face arg)))
(ignore-case company-etags-ignore-case)))
(provide 'company-etags)

View File

@@ -1,6 +1,6 @@
;;; company-files.el --- company-mode completion backend for file names
;;; company-files.el --- company-mode completion backend for file names -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2024 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -38,22 +38,14 @@ The values should use the same format as `completion-ignored-extensions'."
:type '(repeat (string :tag "File extension or directory name"))
:package-version '(company . "0.9.1"))
(defcustom company-files-chop-trailing-slash t
"Non-nil to remove the trailing slash after inserting directory name.
This way it's easy to continue completion by typing `/' again.
Set this to nil to disable that behavior."
:type 'boolean)
(defun company-files--directory-files (dir prefix)
;; Don't use directory-files. It produces directories without trailing /.
(condition-case err
(condition-case _err
(let ((comp (sort (file-name-all-completions prefix dir)
(lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
(when company-files-exclusions
(setq comp (company-files--exclusions-filtered comp)))
(if (equal prefix "")
(if (string-empty-p prefix)
(delete "../" (delete "./" comp))
comp))
(file-error nil)))
@@ -105,54 +97,58 @@ Set this to nil to disable that behavior."
(defvar company-files--completion-cache nil)
(defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
(file (file-name-nondirectory prefix))
(defun company-files--complete (_prefix)
(let* ((full-prefix (company-files--grab-existing-name))
(dir (file-name-directory full-prefix))
(file (file-name-nondirectory full-prefix))
(key (list file
(expand-file-name dir)
(nth 5 (file-attributes dir))))
(completion-ignore-case read-file-name-completion-ignore-case))
(unless (company-file--keys-match-p key (car company-files--completion-cache))
(let* ((candidates (mapcar (lambda (f) (concat dir f))
(company-files--directory-files dir file)))
(unless (or (company-file--keys-match-p key (car company-files--completion-cache))
(not (company-files--connected-p dir)))
(let* ((candidates (company-files--directory-files dir file))
(directories (unless (file-remote-p dir)
(cl-remove-if-not (lambda (f)
(and (company-files--trailing-slash-p f)
(not (file-remote-p f))
(company-files--connected-p f)))
(company-files--trailing-slash-p f))
candidates)))
(children (and directories
(cl-mapcan (lambda (d)
(mapcar (lambda (c) (concat d c))
(company-files--directory-files d "")))
(company-files--directory-files d ""))
directories))))
(setq company-files--completion-cache
(cons key (append candidates children)))))
(all-completions prefix
(cdr company-files--completion-cache))))
(all-completions file (cdr company-files--completion-cache))))
(defun company-files--prefix ()
(let ((existing (company-files--grab-existing-name)))
(when existing
(list existing (company-grab-suffix "[^ '\"\t\n\r/]*/?")))))
(defun company-file--keys-match-p (new old)
(and (equal (cdr old) (cdr new))
(string-prefix-p (car old) (car new))))
(defun company-files--post-completion (arg)
(when (and company-files-chop-trailing-slash
(company-files--trailing-slash-p arg))
(delete-char -1)))
(defun company-files--adjust-boundaries (_file prefix suffix)
(cons
(file-name-nondirectory prefix)
suffix))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
(defun company-files (command &optional arg &rest rest)
"`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-files))
(prefix (company-files--grab-existing-name))
(candidates (company-files--complete arg))
(prefix (company-files--prefix))
(candidates
(company-files--complete arg))
(adjust-boundaries
(company-files--adjust-boundaries arg (nth 0 rest) (nth 1 rest)))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
(post-completion (company-files--post-completion arg))
(kind (if (string-suffix-p "/" arg) 'folder 'file))
(sorted t)
(no-cache t)))

View File

@@ -1,6 +1,6 @@
;;; company-gtags.el --- company-mode completion backend for GNU Global
;;; company-gtags.el --- company-mode completion backend for GNU Global -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2021, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -97,7 +97,6 @@ completion."
(defun company-gtags--fetch-tags (prefix)
(with-temp-buffer
(let (tags)
;; For some reason Global v 6.6.3 is prone to returning exit status 1
;; even on successful searches when '-T' is used.
(when (/= 3 (process-file (company-gtags--executable) nil
@@ -118,7 +117,7 @@ completion."
'meta (match-string 4)
'location (cons (expand-file-name (match-string 3))
(string-to-number (match-string 2)))
))))))
)))))
(defun company-gtags--annotation (arg)
(let ((meta (get-text-property 0 'meta arg)))
@@ -135,14 +134,14 @@ completion."
start (point)))))))
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
(defun company-gtags (command &optional arg &rest _ignored)
"`company-mode' completion backend for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
(prefix (and (company-gtags--executable)
buffer-file-name
(apply #'derived-mode-p company-gtags-modes)
(cl-some #'derived-mode-p company-gtags-modes)
(not (company-in-string-or-comment))
(company-gtags--tags-available-p)
(or (company-grab-symbol) 'stop)))

View File

@@ -1,6 +1,6 @@
;;; company-ispell.el --- company-mode completion backend using Ispell
;;; company-ispell.el --- company-mode completion backend using Ispell -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2016, 2018, 2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2016, 2018, 2021, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -33,51 +33,67 @@
"Completion backend using Ispell."
:group 'company)
(defun company--set-dictionary (symbol value)
(set-default-toplevel-value symbol value)
(company-cache-delete 'ispell-candidates))
(defcustom company-ispell-dictionary nil
"Dictionary to use for `company-ispell'.
If nil, use `ispell-complete-word-dict'."
If nil, use `ispell-complete-word-dict' or `ispell-alternate-dictionary'."
:type '(choice (const :tag "default (nil)" nil)
(file :tag "dictionary" t)))
(file :tag "dictionary" t))
:set #'company--set-dictionary)
(defvar company-ispell-available 'unknown)
(defalias 'company-ispell--lookup-words
(if (fboundp 'ispell-lookup-words)
'ispell-lookup-words
'lookup-words))
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
(company-ispell--lookup-words "WHATEVER")
(ispell-lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company-Ispell: %s" (error-message-string err))
(setq company-ispell-available nil))))
company-ispell-available)
(defun company--ispell-dict ()
"Determine which dictionary to use."
(let ((dict (or company-ispell-dictionary
ispell-complete-word-dict
ispell-alternate-dictionary)))
(when dict
(expand-file-name dict))))
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
(defun company-ispell (command &optional arg &rest _ignored)
"`company-mode' completion backend using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(list
(company-grab-word)
(company-grab-word-suffix))))
(candidates
(let ((words (company-ispell--lookup-words
arg
(or company-ispell-dictionary ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
(let* ((dict (company--ispell-dict))
(all-words
(company-cache-fetch 'ispell-candidates
(lambda () (ispell-lookup-words "" dict))
:check-tag dict))
(completion-ignore-case t))
(if (string-empty-p arg)
;; Small optimization.
words
;; Work around issue #284.
(all-completions arg words))))
all-words
(company-substitute-prefix
arg
;; Work around issue #284.
(all-completions arg all-words)))))
(kind 'text)
(no-cache t)
(sorted t)
(ignore-case 'keep-prefix)))
(ignore-case t)))
(provide 'company-ispell)
;;; company-ispell.el ends here

View File

@@ -1,6 +1,6 @@
;;; company-keywords.el --- A company backend for programming language keywords
;;; company-keywords.el --- A company backend for programming language keywords -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2018, 2020-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2018, 2020-2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -377,6 +377,11 @@
"new" "null" "object" "override" "package" "private" "protected"
"return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
"var" "while" "with" "yield")
(sh-mode
"break" "case" "continue" "do" "done" "elif" "else" "esac" "eval"
"exec" "exit" "export" "false" "fi" "for" "function" "if" "in" "readonly"
"return" "set" "shift" "test" "then" "time" "times" "trap" "true" "unset"
"until" "while")
(swift-mode
"Protocol" "Self" "Type" "and" "as" "assignment" "associatedtype"
"associativity" "available" "break" "case" "catch" "class" "column" "continue"
@@ -403,7 +408,21 @@
"i16" "i32" "i64" "include" "list" "map" "oneway" "optional" "required"
"service" "set" "string" "struct" "throws" "typedef" "void"
)
(tuareg-mode
;; ocaml, from https://v2.ocaml.org/manual/lex.html#sss:keywords
"and" "as" "asr" "assert" "begin" "class"
"constraint" "do" "done" "downto" "else" "end"
"exception" "external" "false" "for" "fun" "function"
"functor" "if" "in" "include" "inherit" "initializer"
"land" "lazy" "let" "lor" "lsl" "lsr"
"lxor" "match" "method" "mod" "module" "mutable"
"new" "nonrec" "object" "of" "open" "or"
"private" "rec" "sig" "struct" "then" "to"
"true" "try" "type" "val" "virtual" "when"
"while" "with"
)
;; aliases
(caml-mode . tuareg-mode)
(js2-mode . javascript-mode)
(js2-jsx-mode . javascript-mode)
(espresso-mode . javascript-mode)
@@ -413,6 +432,7 @@
(cperl-mode . perl-mode)
(jde-mode . java-mode)
(ess-julia-mode . julia-mode)
(php-ts-mode . php-mode)
(phps-mode . php-mode)
(enh-ruby-mode . ruby-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
@@ -439,7 +459,7 @@
(makefile-mode . makefile-statements))))
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
(defun company-keywords (command &optional arg &rest _ignored)
"`company-mode' backend for programming language keywords."
(interactive (list 'interactive))
(cl-case command

View File

@@ -1,6 +1,6 @@
;;; company-nxml.el --- company-mode completion backend for nxml-mode
;;; company-nxml.el --- company-mode completion backend for nxml-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2015, 2017-2018 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2015, 2017-2018, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -71,12 +71,11 @@
(defmacro company-nxml-prepared (&rest body)
(declare (indent 0) (debug t))
`(let ((lt-pos (save-excursion (search-backward "<" nil t)))
xmltok-dtd)
`(let ((lt-pos (save-excursion (search-backward "<" nil t))))
(when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
,@body)))
(defun company-nxml-tag (command &optional arg &rest ignored)
(defun company-nxml-tag (command &optional arg &rest _ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
@@ -86,7 +85,7 @@
arg (rng-match-possible-start-tag-names))))
(sorted t)))
(defun company-nxml-attribute (command &optional arg &rest ignored)
(defun company-nxml-attribute (command &optional arg &rest _ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
@@ -99,7 +98,7 @@
arg (rng-match-possible-attribute-names)))))
(sorted t)))
(defun company-nxml-attribute-value (command &optional arg &rest ignored)
(defun company-nxml-attribute-value (command &optional arg &rest _ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
@@ -121,7 +120,7 @@
arg (rng-match-possible-value-strings))))))))
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
(defun company-nxml (command &optional arg &rest _ignored)
"`company-mode' completion backend for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command

View File

@@ -1,6 +1,6 @@
;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2016, 2022 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2016, 2022, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -41,7 +41,7 @@
(oddmuse-make-completion-table oddmuse-wiki)))))
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
(defun company-oddmuse (command &optional arg &rest _ignored)
"`company-mode' completion backend for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command

View File

@@ -1,10 +1,9 @@
(define-package "company" "20221206.2122" "Modular text completion framework"
'((emacs "25.1"))
:commit "6884e3ad717419b4a64a5fab08c8cb9bd20a0b27" :maintainer
'("Dmitry Gutov" . "dgutov@yandex.ru")
:keywords
'("abbrev" "convenience" "matching")
:url "http://company-mode.github.io/")
;; Local Variables:
;; no-byte-compile: t
;; End:
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company" "20250426.1319"
"Modular text completion framework."
'((emacs "26.1"))
:url "http://company-mode.github.io/"
:commit "41f07c7d401c1374a76f3004a3448d3d36bdf347"
:revdesc "41f07c7d401c"
:keywords '("abbrev" "convenience" "matching")
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev")))

View File

@@ -1,6 +1,6 @@
;;; company-semantic.el --- company-mode completion backend using Semantic
;;; company-semantic.el --- company-mode completion backend using Semantic -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011, 2013-2018 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2018, 2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -126,11 +126,11 @@ and `c-electric-colon', for automatic completion right after \">\" and
(defun company-semantic--prefix ()
(if company-semantic-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
(company-grab-symbol-parts "\\.\\|->\\|::" 2)
(company-grab-symbol-parts)))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
(defun company-semantic (command &optional arg &rest _ignored)
"`company-mode' completion backend using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
@@ -140,7 +140,7 @@ and `c-electric-colon', for automatic completion right after \">\" and
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
(or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
(candidates (if (and (string-empty-p arg)
(not (looking-back "->\\|\\.\\|::" (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
@@ -151,7 +151,7 @@ and `c-electric-colon', for automatic completion right after \">\" and
(doc-buffer (company-semantic-doc-buffer
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
(no-cache (string-empty-p arg))
(duplicates t)
(location (let ((tag (assoc arg company-semantic--current-tags)))
(when (buffer-live-p (semantic-tag-buffer tag))

Some files were not shown because too many files have changed in this diff Show More