Compare commits
83 Commits
pkgs-updat
...
ceb703a085
| Author | SHA1 | Date | |
|---|---|---|---|
| ceb703a085 | |||
| cb7dc65bcf | |||
| 91f37c15fe | |||
| f98d583977 | |||
| e3eab820ce | |||
| ca60fa910e | |||
| cf727799c2 | |||
| 7f7c0af81a | |||
| 3b921ba7c8 | |||
| 16a0a6db93 | |||
| 54e5633369 | |||
| 3258d571cb | |||
| b8349a56eb | |||
| bcf8bd4420 | |||
| c3b89cc11c | |||
| 241b1684c5 | |||
| e6e5602f48 | |||
| 0d6d2afaec | |||
| 3511f44aa5 | |||
| 20d612c301 | |||
| 97e7d3c881 | |||
| 612300aef0 | |||
| beb2daaf06 | |||
| d4702c24f6 | |||
| 280b19d614 | |||
| 56022f7f8b | |||
| 5a1ee56a85 | |||
| b295a1328b | |||
| 79b15d7822 | |||
| a310ee8795 | |||
| 3a0b45f037 | |||
| 83bb13b270 | |||
| e0913c23d6 | |||
| d74e4459cf | |||
| 9fd9666127 | |||
| 4aad0ba8f2 | |||
| c4cb079682 | |||
| f66a2d37e1 | |||
| f3eef8d567 | |||
| 2f868e6b50 | |||
| 46cf268dd7 | |||
| 2f27c73b2f | |||
| 348cc168cc | |||
| 423e200458 | |||
| 5721e18608 | |||
| d6f64e66ea | |||
| 14dcaaddde | |||
| 45d49daef0 | |||
| 59db017445 | |||
| a0e23086ce | |||
| 4fa60b9497 | |||
| 940979a9fe | |||
| 9d25a4c02d | |||
| 7577659e42 | |||
| 6b9f2a0cf1 | |||
| 59aaf6fc14 | |||
| 504c2b1bfa | |||
| 156cec64fb | |||
| 8b80ceda39 | |||
| b18d02d8d5 | |||
| ddba0ba9cd | |||
| 94dd0e848e | |||
| 52815c9fe4 | |||
| b11956a890 | |||
| 5e9bb3b882 | |||
| 3894350a6a | |||
| c43933e9f6 | |||
| 3b54a3236d | |||
| e162a12b58 | |||
| f3935715a4 | |||
| a075f93c3e | |||
| 6253368410 | |||
| ce2c9354ed | |||
| 900a4d9928 | |||
| 3476d496a7 | |||
| 1e9910e471 | |||
| a4e15965bb | |||
| 99a0d6a185 | |||
| d95f45d049 | |||
| 4fe9a6b7e1 | |||
| d861ac5e74 | |||
| 4b839a12cd | |||
| 43d61b31d4 |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -7,6 +7,7 @@ custom.el
|
||||
|
||||
# cache files
|
||||
.cache/
|
||||
eln-cache
|
||||
|
||||
# elpa packages
|
||||
elpa/
|
||||
elpa/
|
||||
|
||||
333
README.md
333
README.md
@@ -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"> </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>
|
||||
|
||||
115
README.org
115
README.org
@@ -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 |
|
||||
|
||||
@@ -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
5
init
@@ -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
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
12
lisp/all-the-icons-ivy-rich/all-the-icons-ivy-rich-pkg.el
Normal file
12
lisp/all-the-icons-ivy-rich/all-the-icons-ivy-rich-pkg.el
Normal 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")))
|
||||
2091
lisp/all-the-icons-ivy-rich/all-the-icons-ivy-rich.el
Normal file
2091
lisp/all-the-icons-ivy-rich/all-the-icons-ivy-rich.el
Normal file
File diff suppressed because it is too large
Load Diff
70
lisp/all-the-icons/all-the-icons-autoloads.el
Normal file
70
lisp/all-the-icons/all-the-icons-autoloads.el
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
;; -*- lexical-binding: t -*-
|
||||
|
||||
(defvar all-the-icons-data/alltheicons-alist
|
||||
'(
|
||||
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
;; -*- lexical-binding: t -*-
|
||||
|
||||
(defvar all-the-icons-data/fa-icon-alist
|
||||
'(
|
||||
|
||||
|
||||
@@ -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" )
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
;; -*- lexical-binding: t -*-
|
||||
|
||||
(defvar all-the-icons-data/material-icons-alist
|
||||
'(("3d_rotation" . "\xe84d")
|
||||
("ac_unit" . "\xeb3b")
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
;; -*- lexical-binding: t -*-
|
||||
|
||||
(defvar all-the-icons-data/octicons-alist
|
||||
'(
|
||||
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
;; -*- lexical-binding: t -*-
|
||||
|
||||
(defvar all-the-icons-data/weather-icons-alist
|
||||
'(
|
||||
|
||||
|
||||
12
lisp/amx/amx-pkg.el
Normal file
12
lisp/amx/amx-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
@@ -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")))
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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.
|
||||
|
||||
|
||||
12
lisp/anaphora/anaphora-pkg.el
Normal file
12
lisp/anaphora/anaphora-pkg.el
Normal 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
474
lisp/anaphora/anaphora.el
Normal 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
|
||||
@@ -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
145
lisp/async/async-package.el
Normal 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
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
11
lisp/avy/avy-pkg.el
Normal 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")))
|
||||
@@ -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'."
|
||||
@@ -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
134
lisp/awesome-tray/README.md
Normal 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!
|
||||
293
lisp/awesome-tray/awesome-tray-faces.el
Normal file
293
lisp/awesome-tray/awesome-tray-faces.el
Normal 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
|
||||
1420
lisp/awesome-tray/awesome-tray.el
Normal file
1420
lisp/awesome-tray/awesome-tray.el
Normal file
File diff suppressed because it is too large
Load Diff
11
lisp/awesome-tray/screenshots/README.md
Normal file
11
lisp/awesome-tray/screenshots/README.md
Normal 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">
|
||||
BIN
lisp/awesome-tray/screenshots/centered.png
Normal file
BIN
lisp/awesome-tray/screenshots/centered.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 18 KiB |
BIN
lisp/awesome-tray/screenshots/screenshot.png
Normal file
BIN
lisp/awesome-tray/screenshots/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 222 KiB |
BIN
lisp/awesome-tray/screenshots/screenshot2.png
Normal file
BIN
lisp/awesome-tray/screenshots/screenshot2.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 18 KiB |
13
lisp/biblio-core/biblio-core-pkg.el
Normal file
13
lisp/biblio-core/biblio-core-pkg.el
Normal 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")))
|
||||
@@ -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))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
16
lisp/bibtex-completion/bibtex-completion-pkg.el
Normal file
16
lisp/bibtex-completion/bibtex-completion-pkg.el
Normal 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")))
|
||||
@@ -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."
|
||||
566
lisp/bind-key.el
566
lisp/bind-key.el
@@ -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
12
lisp/cfrs/cfrs-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
@@ -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))
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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."
|
||||
|
||||
@@ -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.")
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 ."
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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))))))))
|
||||
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)))
|
||||
|
||||
10
lisp/cl-libify/cl-libify-pkg.el
Normal file
10
lisp/cl-libify/cl-libify-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
14
lisp/code-cells/code-cells-pkg.el
Normal file
14
lisp/code-cells/code-cells-pkg.el
Normal 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:
|
||||
442
lisp/code-cells/code-cells.el
Normal file
442
lisp/code-cells/code-cells.el
Normal 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
|
||||
15
lisp/company-anaconda/company-anaconda-pkg.el
Normal file
15
lisp/company-anaconda/company-anaconda-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
11
lisp/company-ledger/company-ledger-pkg.el
Normal file
11
lisp/company-ledger/company-ledger-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
|
||||
12
lisp/company-quickhelp/company-quickhelp-pkg.el
Normal file
12
lisp/company-quickhelp/company-quickhelp-pkg.el
Normal 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")))
|
||||
@@ -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
|
||||
11
lisp/company-statistics/company-statistics-pkg.el
Normal file
11
lisp/company-statistics/company-statistics-pkg.el
Normal 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")))
|
||||
376
lisp/company-statistics/company-statistics.el
Normal file
376
lisp/company-statistics/company-statistics.el
Normal 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
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
@@ -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)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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
Reference in New Issue
Block a user